1package PDF::Builder; 2 3use strict; 4use warnings; 5 6# $VERSION defined here so developers can run PDF::Builder from git. 7# it should be automatically updated as part of the CPAN build. 8our $VERSION = '3.023'; # VERSION 9our $LAST_UPDATE = '3.023'; # manually update whenever code is changed 10 11my $GrTFversion = 16; # minimum version of Graphics::TIFF 12my $LpngVersion = 0.57; # minimum version of Image::PNG::Libpng 13 14use Carp; 15use Encode qw(:all); 16use FileHandle; 17 18use PDF::Builder::Basic::PDF::Utils; 19use PDF::Builder::Util; 20 21use PDF::Builder::Basic::PDF::File; 22use PDF::Builder::Basic::PDF::Pages; 23use PDF::Builder::Page; 24 25use PDF::Builder::Resource::XObject::Form::Hybrid; 26 27use PDF::Builder::Resource::ExtGState; 28use PDF::Builder::Resource::Pattern; 29use PDF::Builder::Resource::Shading; 30 31use PDF::Builder::NamedDestination; 32 33use Scalar::Util qw(weaken); 34 35our @FontDirs = ( (map { "$_/PDF/Builder/fonts" } @INC), 36 qw[ /usr/share/fonts /usr/local/share/fonts c:/windows/fonts c:/winnt/fonts ] ); 37our @MSG_COUNT = (0, # [0] Graphics::TIFF not installed 38 0, # [1] Image::PNG::Libpng not installed 39 0, # [2] TBD... 40 ); 41our $outVer = 1.4; # desired PDF version for output, bump up w/ warning on read or feature output 42our $msgVer = 1; # 0=don't, 1=do issue message when PDF output version is bumped up 43our $myself; # holds self->pdf 44 45=head1 NAME 46 47PDF::Builder - Facilitates the creation and modification of PDF files 48 49=head1 SYNOPSIS 50 51 use PDF::Builder; 52 53 # Create a blank PDF file 54 $pdf = PDF::Builder->new(); 55 56 # Open an existing PDF file 57 $pdf = PDF::Builder->open('some.pdf'); 58 59 # Add a blank page 60 $page = $pdf->page(); 61 62 # Retrieve an existing page 63 $page = $pdf->open_page($page_number); 64 65 # Set the page size 66 $page->mediabox('Letter'); 67 68 # Add a built-in font to the PDF 69 $font = $pdf->corefont('Helvetica-Bold'); 70 71 # Add an external TTF font to the PDF 72 $font = $pdf->ttfont('/path/to/font.ttf'); 73 74 # Add some text to the page 75 $text = $page->text(); 76 $text->font($font, 20); 77 $text->translate(200, 700); 78 $text->text('Hello World!'); 79 80 # Save the PDF 81 $pdf->saveas('/path/to/new.pdf'); 82 83=head1 SOME SPECIAL NOTES 84 85See the file README (in downloadable package and on CPAN) for a summary of 86prerequisites and tools needed to install PDF::Builder, both mandatory and 87optional. 88 89=head2 SOFTWARE DEVELOPMENT KIT 90 91There are four levels of involvement with PDF::Builder. Depending on what you 92want to do, different kinds of installs are recommended. 93See L<PDF::Builder::Docs/Software Development Kit> for suggestions. 94 95=head2 OPTIONAL LIBRARIES 96 97PDF::Builder can make use of some optional libraries, which are not I<required> 98for a successful installation, but improve speed and capabilities. See 99L<PDF::Builder::Docs/Optional Libraries> for more information. 100 101=head2 STRINGS (CHARACTER TEXT) 102 103There are some things you should know about character encoding (for text), 104before you dive in to coding. Please go to L<PDF::Builder::Docs/Strings (Character Text)> and have a read. 105 106=head2 RENDERING ORDER 107 108Invoking "text" and "graphics" methods can lead to unexpected results (a 109different ordering of output than intended). See L<PDF::Builder::Docs/Rendering Order> for more information. 110 111=head2 PDF VERSIONS SUPPORTED 112 113PDF::Builder is mostly PDF 1.4-compliant, but there I<are> complications you 114should be aware of. Please read L<PDF::Builder::Docs/PDF Versions Supported> 115for details. 116 117=head2 SUPPORTED PERL VERSIONS 118 119PDF::Builder intends to support all major Perl versions that were released in 120the past six years, plus one, in order to continue working for the life of 121most long-term-stable (LTS) server distributions. 122See the L<https://www.cpan.org/src/> table 123B<First release in each branch of Perl> x.xxxx0 "Major" release dates. 124 125For example, a version of PDF::Builder released on 2018-06-05 would support 126the last major version of Perl released I<on or after> 2012-06-05 (5.18), and 127then one before that, which would be 5.16. Alternatively, the last major 128version of Perl released I<before> 2012-06-05 is 5.16. 129 130The intent is to avoid expending unnecessary effort in supporting very old 131(obsolete) versions of Perl. 132If you need to use this module on a server with an extremely out-of-date version 133of Perl, consider using either plenv or Perlbrew to run a newer version of Perl 134without needing admin privileges. 135 136=head2 KNOWN ISSUES 137 138This module does not work with perl's -l command-line switch. 139 140There is a file INFO/KNOWN_INCOMP which lists known incompatibilities with 141PDF::API2, in case you're thinking of porting over something from that world, 142or have experience there and want to try PDF::Builder. There is also a file 143INFO/DEPRECATED, which lists things which are planned to be removed at some 144point. 145 146=head2 HISTORY 147 148The history of PDF::Builder is a complex and exciting saga... OK, it may be 149mildly interesting. Have a look at L<PDF::Builder::Docs/History> section. 150 151=head1 AUTHOR 152 153PDF::API2 was originally written by Alfred Reibenschuh. See the HISTORY section 154for more information. 155 156It was maintained by Steve Simms. 157 158PDF::Builder is currently being maintained by Phil M. Perry. 159 160=head2 SUPPORT 161 162The full source is on https://github.com/PhilterPaper/Perl-PDF-Builder. 163 164The release distribution is on CPAN: https://metacpan.org/pod/PDF::Builder. 165 166Bug reports are on https://github.com/PhilterPaper/Perl-PDF-Builder/issues?q=is%3Aissue+sort%3Aupdated-desc (with "bug" label), feature requests have an "enhancement" label, and general discussions (architecture, roadmap, etc.) have a "general discussion" label. 167 168Do B<not> under I<any> circumstances open a PR (Pull Request) to report a bug. It is a waste of both your and our time and effort. Open a regular ticket (issue), and attach a Perl (.pl) program illustrating the problem, if possible. If you believe that you have a program patch, and offer to share it as a PR, we may give the go-ahead. Unsolicited PRs may be closed without further action. 169 170=head1 LICENSE 171 172This software is Copyright (c) 2017-2021 by Phil M. Perry. 173 174This is free software, licensed under: 175 176The GNU Lesser General Public License (LGPL) Version 2.1, February 1999 177 178 (The master copy of this license lives on the GNU website.) 179 (A copy is provided in the INFO/LICENSE file for your convenience.) 180 181This section of Builder.pm is intended only as a very brief summary 182of the license; please consider INFO/LICENSE to be the controlling version, 183if there is any conflict or ambiguity between the two. 184 185This program is free software; you can redistribute it and/or modify it under 186the terms of the GNU Lesser General Public License, as published by the Free 187Software Foundation, either version 2.1 of the License, or (at your option) any 188later version of this license. 189 190NOTE: there are several files in this distribution which were incorporated from 191outside sources and carry different licenses. If a file states that it is under 192a license different than LGPL 2.1, that license and its terms will apply to 193that file, and not LGPL 2.1. 194 195This library is distributed in the hope that it will be useful, but WITHOUT ANY 196WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A 197PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. 198 199=head1 GENERIC METHODS 200 201=over 202 203=item $pdf = PDF::Builder->new(%options) 204 205=item $pdf = PDF::Builder->new() 206 207Creates a new PDF object. 208 209B<Options> 210 211=over 212 213=item -file 214 215If you will be saving it as a file and 216already know the filename, you can give the '-file' option to minimize 217possible memory requirements later on. 218 219=item -compress 220 221The '-compress' option can be 222given to specify stream compression: default is 'flate', 'none' is no 223compression. No other compression methods are currently supported. 224 225=item -outver 226 227The '-outver' option defaults to 1.4 as the output PDF version and the highest 228allowed feature version (attempts to use anything higher will give a warning). 229If an existing PDF with a higher version is read in, -outver will be increased 230to that version, with a warning. 231 232=item -msgver 233 234The '-msgver' option value of 1 (default) gives a warning message if the 235'-outver' PDF level has to be bumped up due to either a higher PDF level file 236being read in, or a higher level feature was requested. A value of 0 237suppresses the warning message. 238 239=item -diaglevel 240 241The '-diaglevel' option can be 242given to specify the level of diagnostics given by IntegrityCheck(). The 243default is level 2 (errors and warnings). 244See L<PDF::Builder::Docs/IntegrityCheck> for more information. 245 246=back 247 248B<Example:> 249 250 $pdf = PDF::Builder->new(); 251 ... 252 print $pdf->stringify(); 253 254 $pdf = PDF::Builder->new(-compress => 'none'); 255 # equivalent to $pdf->{'forcecompress'} = 'none'; (or older, 0) 256 257 $pdf = PDF::Builder->new(); 258 ... 259 $pdf->saveas('our/new.pdf'); 260 261 $pdf = PDF::Builder->new(-file => 'our/new.pdf'); 262 ... 263 $pdf->save(); 264 265=cut 266 267sub new { 268 my ($class, %options) = @_; 269 270 my $self = {}; 271 bless $self, $class; 272 $self->{'pdf'} = PDF::Builder::Basic::PDF::File->new(); 273 274 # make available to other routines 275 $myself = $self->{'pdf'}; 276 277 # default output version 278 $self->{'pdf'}->{' version'} = $outVer; 279 $self->{'pages'} = PDF::Builder::Basic::PDF::Pages->new($self->{'pdf'}); 280 $self->{'pages'}->proc_set(qw(PDF Text ImageB ImageC ImageI)); 281 $self->{'pages'}->{'Resources'} ||= PDFDict(); 282 $self->{'pdf'}->new_obj($self->{'pages'}->{'Resources'}) unless $self->{'pages'}->{'Resources'}->is_obj($self->{'pdf'}); 283 $self->{'catalog'} = $self->{'pdf'}->{'Root'}; 284 weaken $self->{'catalog'}; 285 $self->{'fonts'} = {}; 286 $self->{'pagestack'} = []; 287 288 $self->{'pdf'}->{' userUnit'} = 1.0; # default global User Unit 289 $self->mediabox('letter'); # default to US Letter 8.5in x 11in 290 291 if (exists $options{'-compress'}) { 292 $self->{'forcecompress'} = $options{'-compress'}; 293 # at this point, no validation of given value! none/flate (0/1). 294 # note that >0 is often used as equivalent to 'flate' 295 } else { 296 $self->{'forcecompress'} = 'flate'; 297 # code should also allow integers 0 (= 'none') and >0 (= 'flate') 298 # for compatibility with old usage where forcecompress is directly set. 299 } 300 if (exists $options{'-diaglevel'}) { 301 my $diaglevel = $options{'-diaglevel'}; 302 if ($diaglevel < 0 || $diaglevel > 5) { 303 print "-diaglevel must be in range 0-5. using 2\n"; 304 $diaglevel = 2; 305 } 306 $self->{'diaglevel'} = $diaglevel; 307 } else { 308 $self->{'diaglevel'} = 2; # default: errors and warnings 309 } 310 311 $self->preferences(%options); 312 if (defined $options{'-outver'}) { 313 if ($options{'-outver'} >= 1.4) { 314 $self->{'pdf'}->{' version'} = $outVer = $options{'-outver'}; 315 } else { 316 print STDERR "Invalid -outver given, or less than 1.4. Ignored.\n"; 317 } 318 } 319 if (defined $options{'-msgver'}) { 320 if ($options{'-msgver'} == 0 || $options{'-msgver'} == 1) { 321 $msgVer = $options{'-msgver'}; 322 } else { 323 print STDERR "Invalid -msgver given, not 0 or 1. Ignored.\n"; 324 } 325 } 326 if ($options{'-file'}) { 327 $self->{'pdf'}->create_file($options{'-file'}); 328 $self->{'partial_save'} = 1; 329 } 330 $self->{'infoMeta'} = [qw(Author CreationDate ModDate Creator Producer Title Subject Keywords)]; 331 332 my $version = eval { $PDF::Builder::VERSION } || '(Unreleased Version)'; 333 #$self->info('Producer' => "PDF::Builder $version [$^O]"); 334 $self->info('Producer' => "PDF::Builder $version [see https://github.com/PhilterPaper/Perl-PDF-Builder/blob/master/INFO/SUPPORT]"); 335 336 return $self; 337} # end of new() 338 339=item $pdf = PDF::Builder->open($pdf_file, %options) 340 341=item $pdf = PDF::Builder->open($pdf_file) 342 343Opens an existing PDF file. See C<new()> for options. 344 345B<Example:> 346 347 $pdf = PDF::Builder->open('our/old.pdf'); 348 ... 349 $pdf->saveas('our/new.pdf'); 350 351 $pdf = PDF::Builder->open('our/to/be/updated.pdf'); 352 ... 353 $pdf->update(); 354 355=cut 356 357sub open { ## no critic 358 my ($class, $file, %options) = @_; 359 croak "File '$file' does not exist" unless -f $file; 360 croak "File '$file' is not readable" unless -r $file; 361 362 my $content; 363 my $scalar_fh = FileHandle->new(); 364 CORE::open($scalar_fh, '+<', \$content) or die "Can't begin scalar IO"; 365 binmode $scalar_fh, ':raw'; 366 367 my $disk_fh = FileHandle->new(); 368 CORE::open($disk_fh, '<', $file) or die "Can't open $file for reading: $!"; 369 binmode $disk_fh, ':raw'; 370 $disk_fh->seek(0, 0); 371 my $data; 372 while (not $disk_fh->eof()) { 373 $disk_fh->read($data, 512); 374 $scalar_fh->print($data); 375 } 376 # check if final %%EOF lacks a carriage return on the end (add one) 377 if ($data =~ m/%%EOF$/) { 378 #print "open() says missing final EOF\n"; 379 $scalar_fh->print("\n"); 380 } 381 $disk_fh->close(); 382 $scalar_fh->seek(0, 0); 383 384 my $self = $class->open_scalar($content, %options); 385 $self->{'pdf'}->{' fname'} = $file; 386 387 return $self; 388} # end of open() 389 390# when outputting a PDF feature, verCheckOutput(n, 'feature name') returns TRUE 391# if n > $pdf->{' version'), plus a warning message. It returns FALSE otherwise. 392# 393# a typical use: 394# 395# PDF::Builder->verCheckOutput(1.6, "portzebie with foo-dangle"); 396# 397# if -msgver defaults to 1, a message will be output if the output PDF version 398# has to be increased to 1.6 in order to use the "portzebie" feature 399# 400# this is still somewhat experimental, and as experience is gained, the code 401# might have to be modified. 402# 403sub verCheckOutput { 404 my ($dummy, $PDFver, $featureName) = @_; # $self will be this package's 405 406 # check if feature required PDF version is higher than planned output 407 # ' version' should be the same as $outVer 408 if ($PDFver > $outVer) { 409 if ($msgVer) { 410 print "PDF version of requested feature '$featureName'\n is higher than outVer of $outVer (outVer reset to $PDFver)\n"; 411 } 412 $outVer = $myself->{' version'} = $PDFver; 413 return 1; 414 } else { 415 return 0; 416 } 417} 418# when reading in a PDF, verCheckInput(n) gives a warning message if n (the PDF 419# version just read in) > outVer, and resets outVer to n. return TRUE if 420# outVer changed, FALSE otherwise. outVer is used instead of 421# $pdf->{' version'} because the latter is often overwritten by a file read 422# operation. 423# 424# this is still somewhat experimental, and as experience is gained, the code 425# might have to be modified. 426# 427# WARNING: just because the PDF output version has been increased does NOT 428# guarantee that any particular content will be handled correctly! There are 429# many known cases of PDF 1.5 and up files being read in, that have content 430# that PDF::Builder does not handle correctly, corrupting the resulting PDF. 431# Pay attention to run-time warning messages that the PDF output level has 432# been increased due to a PDF file being read in, and check the resulting 433# file carefully. 434 435sub verCheckInput { 436 my ($self, $PDFver) = @_; 437 438 # warning message and bump up outVer if read-in PDF level higher 439 if ($PDFver > $outVer) { 440 if ($msgVer) { 441 print "PDF version just read in is higher than outVer of $outVer (outVer reset to $PDFver)\n"; 442 } 443 $outVer = $self->{'pdf'}->{' version'} = $PDFver; 444 return 1; 445 } else { 446 return 0; 447 } 448} 449 450=item $pdf = PDF::Builder->open_scalar($pdf_string, %options) 451 452=item $pdf = PDF::Builder->open_scalar($pdf_string) 453 454Opens a PDF contained in a string. See C<new()> for other options. 455 456=over 457 458=item -diags => 1 459 460Display warnings when non-conforming PDF structure is found, and fix up 461where possible. See L<PDF::Builder::Basic::PDF::File> for more information. 462 463=back 464 465B<Example:> 466 467 # Read a PDF into a string, for the purpose of demonstration 468 open $fh, 'our/old.pdf' or die $@; 469 undef $/; # Read the whole file at once 470 $pdf_string = <$fh>; 471 472 $pdf = PDF::Builder->open_scalar($pdf_string); 473 ... 474 $pdf->saveas('our/new.pdf'); 475 476 477=cut 478 479sub open_scalar { 480 my ($class, $content, %options) = @_; 481 482 my $self = {}; 483 bless $self, $class; 484 foreach my $parameter (keys %options) { 485 $self->default($parameter, $options{$parameter}); 486 } 487 488 $self->{'content_ref'} = \$content; 489 my $diaglevel = 2; 490 if (defined $self->{'diaglevel'}) { $diaglevel = $self->{'diaglevel'}; } 491 if ($diaglevel < 0 || $diaglevel > 5) { $diaglevel = 2; } 492 my $newVer = $self->IntegrityCheck($diaglevel, $content); 493 # if Version override defined in PDF, need to overwrite the %PDF-x.y 494 # statement with the new (if higher) value. it's too late to wait until 495 # after File->open, as it's already complained about some >1.4 features. 496 if (defined $newVer) { 497 my ($verStr, $currentVer, $pos); 498 $pos = index $content, "%PDF-"; 499 if ($pos < 0) { die "no PDF version found in PDF input!\n"; } 500 # assume major and minor PDF version numbers max 2 digits each for now 501 # (are 1 or 2 and 0-7 at this writing) 502 $verStr = substr($content, $pos, 10); 503 if ($verStr =~ m#^%PDF-(\d+)\.(\d+)#) { 504 $currentVer = "$1.$2"; 505 } else { 506 die "unable to get PDF input's version number.\n"; 507 } 508 if ($newVer > $currentVer) { 509 if (length($newVer) > length($currentVer)) { 510 print STDERR "Unable to update 'content' version because override '$newVer' is longer than header version '$currentVer'.\nYou may receive warnings about features that bump up the PDF level.\n"; 511 } else { 512 if (length($newVer) < length($currentVer)) { 513 # unlikely, but cover all the bases 514 $newVer = substr($newVer, 0, length($currentVer)); 515 } 516 substr($content, $pos+5, length($newVer)) = $newVer; 517 $outVer = $newVer; 518 } 519 } 520 } 521 522 my $fh; 523 CORE::open($fh, '+<', \$content) or die "Can't begin scalar IO"; 524 525 # this would replace any existing self->pdf with a new one 526 $self->{'pdf'} = PDF::Builder::Basic::PDF::File->open($fh, 1, %options); 527 $self->{'pdf'}->{'Root'}->realise(); 528 $self->{'pages'} = $self->{'pdf'}->{'Root'}->{'Pages'}->realise(); 529 weaken $self->{'pages'}; 530 531 $self->{'pdf'}->{' version'} ||= 1.4; # default minimum 532 # if version higher than desired output PDF level, give warning and 533 # bump up desired output PDF level 534 $self->verCheckInput($self->{'pdf'}->{' version'}); 535 536 my @pages = _proc_pages($self->{'pdf'}, $self->{'pages'}); 537 $self->{'pagestack'} = [sort { $a->{' pnum'} <=> $b->{' pnum'} } @pages]; 538 weaken $self->{'pagestack'}->[$_] for (0 .. scalar @{$self->{'pagestack'}}); 539 $self->{'catalog'} = $self->{'pdf'}->{'Root'}; 540 weaken $self->{'catalog'}; 541 $self->{'opened_scalar'} = 1; 542 if (exists $options{'-compress'}) { 543 $self->{'forcecompress'} = $options{'-compress'}; 544 # at this point, no validation of given value! none/flate (0/1). 545 # note that >0 is often used as equivalent to 'flate' 546 } else { 547 $self->{'forcecompress'} = 'flate'; 548 # code should also allow integers 0 (= 'none') and >0 (= 'flate') 549 # for compatibility with old usage where forcecompress is directly set. 550 } 551 if (exists $options{'-diaglevel'}) { 552 $self->{'diaglevel'} = $options{'-diaglevel'}; 553 if ($self->{'diaglevel'} < 0 || $self->{'diaglevel'} > 5) { 554 $self->{'diaglevel'} = 2; 555 } 556 } else { 557 $self->{'diaglevel'} = 2; 558 } 559 $self->{'fonts'} = {}; 560 $self->{'infoMeta'} = [qw(Author CreationDate ModDate Creator Producer Title Subject Keywords)]; 561 562 return $self; 563} # end of open_scalar() 564 565=item $pdf->preferences(%options) 566 567Controls viewing preferences for the PDF, including the B<Page Mode>, 568B<Page Layout>, B<Viewer>, and B<Initial Page> Options. See 569L<PDF::Builder::Docs/Preferences - set user display preferences> for details on all these 570option groups. 571 572=cut 573 574sub preferences { 575 my ($self, %options) = @_; 576 577 # Page Mode Options 578 if ($options{'-fullscreen'}) { 579 $self->{'catalog'}->{'PageMode'} = PDFName('FullScreen'); 580 } elsif ($options{'-thumbs'}) { 581 $self->{'catalog'}->{'PageMode'} = PDFName('UseThumbs'); 582 } elsif ($options{'-outlines'}) { 583 $self->{'catalog'}->{'PageMode'} = PDFName('UseOutlines'); 584 } else { 585 $self->{'catalog'}->{'PageMode'} = PDFName('UseNone'); 586 } 587 588 # Page Layout Options 589 if ($options{'-singlepage'}) { 590 $self->{'catalog'}->{'PageLayout'} = PDFName('SinglePage'); 591 } elsif ($options{'-onecolumn'}) { 592 $self->{'catalog'}->{'PageLayout'} = PDFName('OneColumn'); 593 } elsif ($options{'-twocolumnleft'}) { 594 $self->{'catalog'}->{'PageLayout'} = PDFName('TwoColumnLeft'); 595 } elsif ($options{'-twocolumnright'}) { 596 $self->{'catalog'}->{'PageLayout'} = PDFName('TwoColumnRight'); 597 } else { 598 $self->{'catalog'}->{'PageLayout'} = PDFName('SinglePage'); 599 } 600 601 # Viewer Preferences 602 $self->{'catalog'}->{'ViewerPreferences'} ||= PDFDict(); 603 $self->{'catalog'}->{'ViewerPreferences'}->realise(); 604 605 if ($options{'-hidetoolbar'}) { 606 $self->{'catalog'}->{'ViewerPreferences'}->{'HideToolbar'} = PDFBool(1); 607 } 608 if ($options{'-hidemenubar'}) { 609 $self->{'catalog'}->{'ViewerPreferences'}->{'HideMenubar'} = PDFBool(1); 610 } 611 if ($options{'-hidewindowui'}) { 612 $self->{'catalog'}->{'ViewerPreferences'}->{'HideWindowUI'} = PDFBool(1); 613 } 614 if ($options{'-fitwindow'}) { 615 $self->{'catalog'}->{'ViewerPreferences'}->{'FitWindow'} = PDFBool(1); 616 } 617 if ($options{'-centerwindow'}) { 618 $self->{'catalog'}->{'ViewerPreferences'}->{'CenterWindow'} = PDFBool(1); 619 } 620 if ($options{'-displaytitle'}) { 621 $self->{'catalog'}->{'ViewerPreferences'}->{'DisplayDocTitle'} = PDFBool(1); 622 } 623 if ($options{'-righttoleft'}) { 624 $self->{'catalog'}->{'ViewerPreferences'}->{'Direction'} = PDFName('R2L'); 625 } 626 627 if ($options{'-afterfullscreenthumbs'}) { 628 $self->{'catalog'}->{'ViewerPreferences'}->{'NonFullScreenPageMode'} = PDFName('UseThumbs'); 629 } elsif ($options{'-afterfullscreenoutlines'}) { 630 $self->{'catalog'}->{'ViewerPreferences'}->{'NonFullScreenPageMode'} = PDFName('UseOutlines'); 631 } else { 632 $self->{'catalog'}->{'ViewerPreferences'}->{'NonFullScreenPageMode'} = PDFName('UseNone'); 633 } 634 635 if ($options{'-printscalingnone'}) { 636 $self->{'catalog'}->{'ViewerPreferences'}->{'PrintScaling'} = PDFName('None'); 637 } 638 639 if ($options{'-simplex'}) { 640 $self->{'catalog'}->{'ViewerPreferences'}->{'Duplex'} = PDFName('Simplex'); 641 } elsif ($options{'-duplexfliplongedge'}) { 642 $self->{'catalog'}->{'ViewerPreferences'}->{'Duplex'} = PDFName('DuplexFlipLongEdge'); 643 } elsif ($options{'-duplexflipshortedge'}) { 644 $self->{'catalog'}->{'ViewerPreferences'}->{'Duplex'} = PDFName('DuplexFlipShortEdge'); 645 } 646 647 # Open Action 648 if ($options{'-firstpage'}) { 649 my ($page, %args) = @{$options{'-firstpage'}}; 650 $args{'-fit'} = 1 unless scalar keys %args; 651 652 # $page can be either a page number (which needs to be wrapped 653 # in PDFNum) or a page object (which doesn't). 654 $page = PDFNum($page) unless ref($page); 655 656 if (defined $args{'-fit'}) { 657 $self->{'catalog'}->{'OpenAction'} = PDFArray($page, PDFName('Fit')); 658 } elsif (defined $args{'-fith'}) { 659 $self->{'catalog'}->{'OpenAction'} = PDFArray($page, PDFName('FitH'), PDFNum($args{'-fith'})); 660 } elsif (defined $args{'-fitb'}) { 661 $self->{'catalog'}->{'OpenAction'} = PDFArray($page, PDFName('FitB')); 662 } elsif (defined $args{'-fitbh'}) { 663 $self->{'catalog'}->{'OpenAction'} = PDFArray($page, PDFName('FitBH'), PDFNum($args{'-fitbh'})); 664 } elsif (defined $args{'-fitv'}) { 665 $self->{'catalog'}->{'OpenAction'} = PDFArray($page, PDFName('FitV'), PDFNum($args{'-fitv'})); 666 } elsif (defined $args{'-fitbv'}) { 667 $self->{'catalog'}->{'OpenAction'} = PDFArray($page, PDFName('FitBV'), PDFNum($args{'-fitbv'})); 668 } elsif (defined $args{'-fitr'}) { 669 croak 'insufficient parameters to -fitr => []' unless scalar @{$args{'-fitr'}} == 4; 670 $self->{'catalog'}->{'OpenAction'} = PDFArray($page, PDFName('FitR'), map { PDFNum($_) } @{$args{'-fitr'}}); 671 } elsif (defined $args{'-xyz'}) { 672 croak 'insufficient parameters to -xyz => []' unless scalar @{$args{'-xyz'}} == 3; 673 $self->{'catalog'}->{'OpenAction'} = PDFArray($page, PDFName('XYZ'), map { PDFNum($_) } @{$args{'-xyz'}}); 674 } 675 } 676 $self->{'pdf'}->out_obj($self->{'catalog'}); 677 678 return $self; 679} # end of preferences() 680 681=item $val = $pdf->default($parameter) 682 683=item $pdf->default($parameter, $value) 684 685Gets/sets the default value for a behavior of PDF::Builder. 686 687B<Supported Parameters:> 688 689=over 690 691=item nounrotate 692 693prohibits Builder from rotating imported/opened page to re-create a 694default pdf-context. 695 696=item pageencaps 697 698enables Builder's adding save/restore commands upon importing/opening 699pages to preserve graphics-state for modification. 700 701=item copyannots 702 703enables importing of annotations (B<*EXPERIMENTAL*>). 704 705=back 706 707B<CAUTION:> Perl::Critic (tools/1_pc.pl) has started flagging the name 708"default" as a reserved keyword in higher Perl versions. Use with caution, and 709be aware that this name I<may> have to be changed in the future. 710 711=cut 712 713sub default { 714 my ($self, $parameter, $value) = @_; 715 716 # Parameter names may consist of lowercase letters, numbers, and underscores 717 $parameter = lc $parameter; 718 $parameter =~ s/[^a-z\d_]//g; 719 720 my $previous_value = $self->{$parameter}; 721 if (defined $value) { 722 $self->{$parameter} = $value; 723 } 724 725 return $previous_value; 726} 727 728=item $version = $pdf->version($new_version) 729 730=item $version = $pdf->version() 731 732Get/set the PDF version (e.g. 1.4). 733 734For compatibility with earlier releases, if no decimal point is given, assume 735"1." precedes the number given. 736 737A warning message is given if you attempt to I<decrease> the PDF version, as you 738might have already read in a higher level file, or used a higher level feature. 739 740=cut 741 742sub version { 743 my $self = shift(); 744 if (scalar @_) { 745 my $version = shift(); 746 if ($version =~ m/^\d+$/) { $version = "1.$version"; } # no x.? assume it's 1.something 747 croak "Invalid version $version" unless $version =~ /^(\d+\.\d+)$/; 748 if ($outVer > $1) { 749 print "Warning: call to self->version() to LOWER the output PDF version number!\n"; 750 } 751 $self->{'pdf'}->{' version'} = $outVer = $1; 752 } 753 754 return $self->{'pdf'}->{' version'}; 755} 756 757=item $bool = $pdf->isEncrypted() 758 759Checks if the previously opened PDF is encrypted. 760 761=cut 762 763sub isEncrypted { 764 my $self = shift(); 765 return defined($self->{'pdf'}->{'Encrypt'}) ? 1 : 0; 766} 767 768=item %infohash = $pdf->info(%infohash) 769 770Gets/sets the info structure of the document. 771 772See L<PDF::Builder::Docs/info Example> section for an example of the use 773of this method. 774 775=cut 776 777sub info { 778 my ($self, %opt) = @_; 779 780 if (not defined($self->{'pdf'}->{'Info'})) { 781 $self->{'pdf'}->{'Info'} = PDFDict(); 782 $self->{'pdf'}->new_obj($self->{'pdf'}->{'Info'}); 783 } else { 784 $self->{'pdf'}->{'Info'}->realise(); 785 } 786 787 # Maintenance Note: Since we're not shifting at the beginning of 788 # this sub, this "if" will always be true 789 if (scalar @_) { 790 foreach my $k (@{$self->{'infoMeta'}}) { 791 next unless defined $opt{$k}; 792 $self->{'pdf'}->{'Info'}->{$k} = PDFString($opt{$k} || 'NONE', 'm'); 793 } 794 $self->{'pdf'}->out_obj($self->{'pdf'}->{'Info'}); 795 } 796 797 if (defined $self->{'pdf'}->{'Info'}) { 798 %opt = (); 799 foreach my $k (@{$self->{'infoMeta'}}) { 800 next unless defined $self->{'pdf'}->{'Info'}->{$k}; 801 $opt{$k} = $self->{'pdf'}->{'Info'}->{$k}->val(); 802 if ((unpack('n', $opt{$k}) == 0xfffe) or (unpack('n', $opt{$k}) == 0xfeff)) { 803 $opt{$k} = decode('UTF-16', $self->{'pdf'}->{'Info'}->{$k}->val()); 804 } 805 } 806 } 807 808 return %opt; 809} # end of info() 810 811=item @metadata_attributes = $pdf->infoMetaAttributes(@metadata_attributes) 812 813Gets/sets the supported info-structure tags. 814 815B<Example:> 816 817 @attributes = $pdf->infoMetaAttributes; 818 print "Supported Attributes: @attr\n"; 819 820 @attributes = $pdf->infoMetaAttributes('CustomField1'); 821 print "Supported Attributes: @attributes\n"; 822 823=cut 824 825sub infoMetaAttributes { 826 my ($self, @attr) = @_; 827 828 if (scalar @attr) { 829 my %at = map { $_ => 1 } @{$self->{'infoMeta'}}, @attr; 830 @{$self->{'infoMeta'}} = keys %at; 831 } 832 833 return @{$self->{'infoMeta'}}; 834} 835 836=item $xml = $pdf->xmpMetadata($xml) 837 838Gets/sets the XMP XML data stream. 839 840See L<PDF::Builder::Docs/XMP XML example> section for an example of the use 841of this method. 842 843=cut 844 845sub xmpMetadata { 846 my ($self, $value) = @_; 847 848 if (not defined($self->{'catalog'}->{'Metadata'})) { 849 $self->{'catalog'}->{'Metadata'} = PDFDict(); 850 $self->{'catalog'}->{'Metadata'}->{'Type'} = PDFName('Metadata'); 851 $self->{'catalog'}->{'Metadata'}->{'Subtype'} = PDFName('XML'); 852 $self->{'pdf'}->new_obj($self->{'catalog'}->{'Metadata'}); 853 } else { 854 $self->{'catalog'}->{'Metadata'}->realise(); 855 $self->{'catalog'}->{'Metadata'}->{' stream'} = unfilter($self->{'catalog'}->{'Metadata'}->{'Filter'}, $self->{'catalog'}->{'Metadata'}->{' stream'}); 856 delete $self->{'catalog'}->{'Metadata'}->{' nofilt'}; 857 delete $self->{'catalog'}->{'Metadata'}->{'Filter'}; 858 } 859 860 my $md = $self->{'catalog'}->{'Metadata'}; 861 862 if (defined $value) { 863 $md->{' stream'} = $value; 864 delete $md->{'Filter'}; 865 delete $md->{' nofilt'}; 866 $self->{'pdf'}->out_obj($md); 867 $self->{'pdf'}->out_obj($self->{'catalog'}); 868 } 869 870 return $md->{' stream'}; 871} # end of xmpMetadata() 872 873=item $pdf->pageLabel($index, $options) 874 875Sets page label options. 876 877B<Supported Options:> 878 879=over 880 881=item -style 882 883Roman, roman, decimal, Alpha or alpha. 884 885=item -start 886 887Restart numbering at given number. 888 889=item -prefix 890 891Text prefix for numbering. 892 893=back 894 895B<Example:> 896 897 # Start with Roman Numerals 898 $pdf->pageLabel(0, { 899 -style => 'roman', 900 }); 901 902 # Switch to Arabic 903 $pdf->pageLabel(4, { 904 -style => 'decimal', 905 }); 906 907 # Numbering for Appendix A 908 $pdf->pageLabel(32, { 909 -start => 1, 910 -prefix => 'A-' 911 }); 912 913 # Numbering for Appendix B 914 $pdf->pageLabel( 36, { 915 -start => 1, 916 -prefix => 'B-' 917 }); 918 919 # Numbering for the Index 920 $pdf->pageLabel(40, { 921 -style => 'Roman' 922 -start => 1, 923 -prefix => 'Index ' 924 }); 925 926=cut 927 928sub pageLabel { 929 my $self = shift(); 930 931 $self->{'catalog'}->{'PageLabels'} ||= PDFDict(); 932 $self->{'catalog'}->{'PageLabels'}->{'Nums'} ||= PDFArray(); 933 934 my $nums = $self->{'catalog'}->{'PageLabels'}->{'Nums'}; 935 while (scalar @_) { 936 my $index = shift(); 937 my $opts = shift(); 938 939 $nums->add_elements(PDFNum($index)); 940 941 my $d = PDFDict(); 942 if (defined $opts->{'-style'}) { 943 $d->{'S'} = PDFName($opts->{'-style'} eq 'Roman' ? 'R' : 944 $opts->{'-style'} eq 'roman' ? 'r' : 945 $opts->{'-style'} eq 'Alpha' ? 'A' : 946 $opts->{'-style'} eq 'alpha' ? 'a' : 'D'); 947 } else { 948 $d->{'S'} = PDFName('D'); 949 } 950 951 if (defined $opts->{'-prefix'}) { 952 $d->{'P'} = PDFString($opts->{'-prefix'}, 's'); 953 } 954 955 if (defined $opts->{'-start'}) { 956 $d->{'St'} = PDFNum($opts->{'-start'}); 957 } 958 959 $nums->add_elements($d); 960 } 961 962 return; 963} # end of pageLabel() 964 965=item $pdf->finishobjects(@objects) 966 967Force objects to be written to file if possible. 968 969B<Example:> 970 971 $pdf = PDF::Builder->new(-file => 'our/new.pdf'); 972 ... 973 $pdf->finishobjects($page, $gfx, $txt); 974 ... 975 $pdf->save(); 976 977=cut 978 979sub finishobjects { 980 my ($self, @objs) = @_; 981 982 if ($self->{'opened_scalar'}) { 983 die "invalid method invocation: no file, use 'saveas' instead."; 984 } elsif ($self->{'partial_save'}) { 985 $self->{'pdf'}->ship_out(@objs); 986 } else { 987 die "invalid method invocation: no file, use 'saveas' instead."; 988 } 989 990 return; 991} 992 993sub _proc_pages { 994 my ($pdf, $object) = @_; 995 996 if (defined $object->{'Resources'}) { 997 eval { 998 $object->{'Resources'}->realise(); 999 }; 1000 } 1001 1002 my @pages; 1003 $pdf->{' apipagecount'} ||= 0; 1004 foreach my $page ($object->{'Kids'}->elements()) { 1005 $page->realise(); 1006 if ($page->{'Type'}->val() eq 'Pages') { 1007 push @pages, _proc_pages($pdf, $page); 1008 } 1009 else { 1010 $pdf->{' apipagecount'}++; 1011 $page->{' pnum'} = $pdf->{' apipagecount'}; 1012 if (defined $page->{'Resources'}) { 1013 eval { 1014 $page->{'Resources'}->realise(); 1015 }; 1016 } 1017 push @pages, $page; 1018 } 1019 } 1020 1021 return @pages; 1022} # end of _proc_pages() 1023 1024=item $pdf->update() 1025 1026Saves a previously opened document. 1027 1028B<Example:> 1029 1030 $pdf = PDF::Builder->open('our/to/be/updated.pdf'); 1031 ... 1032 $pdf->update(); 1033 1034=cut 1035 1036sub update { 1037 my $self = shift(); 1038 $self->saveas($self->{'pdf'}->{' fname'}); 1039 return; 1040} 1041 1042=item $pdf->saveas($file) 1043 1044Save the document to $file and remove the object structure from memory. 1045 1046B<Caution:> Although the object C<$pdf> will still exist, it is no longer 1047usable for any purpose after invoking this method! You will receive error 1048messages about "can't call method new_obj on an undefined value". 1049 1050B<Example:> 1051 1052 $pdf = PDF::Builder->new(); 1053 ... 1054 $pdf->saveas('our/new.pdf'); 1055 1056=cut 1057 1058sub saveas { 1059 my ($self, $file) = @_; 1060 1061 if ($self->{'opened_scalar'}) { 1062 $self->{'pdf'}->append_file(); 1063 my $fh; 1064 CORE::open($fh, '>', $file) or die "Can't open $file for writing: $!"; 1065 binmode($fh, ':raw'); 1066 print $fh ${$self->{'content_ref'}}; 1067 CORE::close($fh); 1068 } elsif ($self->{'partial_save'}) { 1069 $self->{'pdf'}->close_file(); 1070 } else { 1071 $self->{'pdf'}->out_file($file); 1072 } 1073 1074 $self->end(); 1075 return; 1076} 1077 1078=item $pdf->save() 1079 1080Save the document to an already-defined file (or filename) and 1081remove the object structure from memory. 1082 1083B<Caution:> Although the object C<$pdf> will still exist, it is no longer 1084usable for any purpose after invoking this method! You will receive error 1085messages about "can't call method new_obj on an undefined value". 1086 1087B<Example:> 1088 1089 $pdf = PDF::Builder->new(-file => 'file_to_output'); 1090 ... 1091 $pdf->save(); 1092 1093=cut 1094 1095sub save { 1096 my ($self) = @_; 1097 1098 if ($self->{'opened_scalar'}) { 1099 die "Invalid method invocation: use 'saveas' instead of 'save'."; 1100 } elsif ($self->{'partial_save'}) { 1101 $self->{'pdf'}->close_file(); 1102 } else { 1103 die "Invalid method invocation: use 'saveas' instead of 'save'."; 1104 } 1105 1106 $self->end(); 1107 return; 1108} 1109 1110=item $string = $pdf->stringify() 1111 1112Return the document as a string and remove the object structure from memory. 1113 1114B<Caution:> Although the object C<$pdf> will still exist, it is no longer 1115usable for any purpose after invoking this method! You will receive error 1116messages about "can't call method new_obj on an undefined value". 1117 1118B<Example:> 1119 1120 $pdf = PDF::Builder->new(); 1121 ... 1122 print $pdf->stringify(); 1123 1124=cut 1125 1126# Maintainer's note: The object is being destroyed because it contains 1127# circular references that would otherwise result in memory not being 1128# freed if the object merely goes out of scope. If possible, the 1129# circular references should be eliminated so that stringify doesn't 1130# need to be destructive. 1131# 1132# I've opted not to just require a separate call to release() because 1133# it would likely introduce memory leaks in many existing programs 1134# that use this module. 1135# - Steve S. (see bug RT 81530) 1136 1137sub stringify { 1138 my $self = shift(); 1139 1140 my $str = ''; 1141 # is only set to 1 (within open_scalar()), otherwise is undef 1142 if ($self->{'opened_scalar'}) { 1143 $self->{'pdf'}->append_file(); 1144 $str = ${$self->{'content_ref'}}; 1145 } else { 1146 my $fh = FileHandle->new(); 1147 # we should be writing to the STRING $str 1148 CORE::open($fh, '>', \$str) || die "Can't begin scalar IO"; 1149 $self->{'pdf'}->out_file($fh); 1150 $fh->close(); 1151 } 1152 $self->end(); 1153 1154 return $str; 1155} 1156 1157# there IS a release() method defined and documented in Basic/PDF/File.pm 1158# it's not clear whether this release is just an internal (rename to _release) 1159sub release { 1160 my $self = shift(); 1161 $self->end(); 1162 return; 1163} 1164 1165=item $pdf->end() 1166 1167Remove the object structure from memory. PDF::Builder contains circular 1168references, so this call is necessary in long-running processes to 1169keep from running out of memory. 1170 1171This will be called automatically when you save or stringify a PDF. 1172You should only need to call it explicitly if you are reading PDF 1173files and not writing them. 1174 1175=cut 1176 1177sub end { 1178 my $self = shift(); 1179 $self->{'pdf'}->release() if defined $self->{'pdf'}; 1180 1181 foreach my $key (keys %$self) { 1182 $self->{$key} = undef; 1183 delete $self->{$key}; 1184 } 1185 1186 return; 1187} 1188 1189=back 1190 1191=head1 PAGE METHODS 1192 1193=over 1194 1195=item $page = $pdf->page() 1196 1197=item $page = $pdf->page($page_number) 1198 1199Returns a I<new> page object. By default, the page is added to the end 1200of the document. If you give an existing page number, the new page 1201will be inserted in that position, pushing existing pages back by 1 (e.g., 1202C<page(5)> would insert an empty page 5, with the old page 5 now page 6, 1203etc. 1204 1205If $page_number is -1, the new page is inserted as the second-last page; 1206if $page_number is 0, the new page is inserted as the last page. 1207 1208B<Example:> 1209 1210 $pdf = PDF::Builder->new(); 1211 1212 # Add a page. This becomes page 1. 1213 $page = $pdf->page(); 1214 1215 # Add a new first page. $page becomes page 2. 1216 $another_page = $pdf->page(1); 1217 1218=cut 1219 1220sub page { 1221 my $self = shift(); 1222 my $index = shift() || 0; # default to new "last" page 1223 my $page; 1224 1225 if ($index == 0) { 1226 $page = PDF::Builder::Page->new($self->{'pdf'}, $self->{'pages'}); 1227 } else { 1228 $page = PDF::Builder::Page->new($self->{'pdf'}, $self->{'pages'}, $index-1); 1229 } 1230 $page->{' apipdf'} = $self->{'pdf'}; 1231 $page->{' api'} = $self; 1232 weaken $page->{' apipdf'}; 1233 weaken $page->{' api'}; 1234 $self->{'pdf'}->out_obj($page); 1235 $self->{'pdf'}->out_obj($self->{'pages'}); 1236 if ($index == 0) { 1237 push @{$self->{'pagestack'}}, $page; 1238 weaken $self->{'pagestack'}->[-1]; 1239 } elsif ($index < 0) { 1240 splice @{$self->{'pagestack'}}, $index, 0, $page; 1241 weaken $self->{'pagestack'}->[$index]; 1242 } else { 1243 splice @{$self->{'pagestack'}}, $index-1, 0, $page; 1244 weaken $self->{'pagestack'}->[$index - 1]; 1245 } 1246 1247 # $page->{'Resources'}=$self->{'pages'}->{'Resources'}; 1248 return $page; 1249} # end of page() 1250 1251=item $page = $pdf->open_page($page_number) 1252 1253Returns the L<PDF::Builder::Page> object of page $page_number. 1254This is similar to C<< $page = $pdf->page() >>, except that C<$page> is 1255I<not> a new, empty page; but contains the contents of that existing page. 1256 1257If $page_number is 0 or -1, it will return the last page in the 1258document. 1259 1260B<Example:> 1261 1262 $pdf = PDF::Builder->open('our/99page.pdf'); 1263 $page = $pdf->open_page(1); # returns the first page 1264 $page = $pdf->open_page(99); # returns the last page 1265 $page = $pdf->open_page(-1); # returns the last page 1266 $page = $pdf->open_page(999); # returns undef 1267 1268=cut 1269 1270sub open_page { 1271 my $self = shift(); 1272 my $index = shift() || 0; 1273 my ($page, $rotate, $media, $trans); 1274 1275 if ($index == 0) { 1276 $page = $self->{'pagestack'}->[-1]; 1277 } elsif ($index < 0) { 1278 $page = $self->{'pagestack'}->[$index]; 1279 } else { 1280 $page = $self->{'pagestack'}->[$index - 1]; 1281 } 1282 return unless ref($page); 1283 1284 if (ref($page) ne 'PDF::Builder::Page') { 1285 bless $page, 'PDF::Builder::Page'; 1286 $page->{' apipdf'} = $self->{'pdf'}; 1287 $page->{' api'} = $self; 1288 weaken $page->{' apipdf'}; 1289 weaken $page->{' api'}; 1290 $self->{'pdf'}->out_obj($page); 1291 if (($rotate = $page->find_prop('Rotate')) and not $page->{' opened'}) { 1292 $rotate = ($rotate->val() + 360) % 360; 1293 1294 if ($rotate != 0 and not $self->default('nounrotate')) { 1295 $page->{'Rotate'} = PDFNum(0); 1296 foreach my $mediatype (qw(MediaBox CropBox BleedBox TrimBox ArtBox)) { 1297 if ($media = $page->find_prop($mediatype)) { 1298 $media = [ map { $_->val() } $media->elements() ]; 1299 } else { 1300 $media = [0, 0, 612, 792]; # US Letter default 1301 next if $mediatype ne 'MediaBox'; 1302 } 1303 if ($rotate == 90) { 1304 $trans = "0 -1 1 0 0 $media->[2] cm" if $mediatype eq 'MediaBox'; 1305 $media = [$media->[1], $media->[0], $media->[3], $media->[2]]; 1306 } elsif ($rotate == 180) { 1307 $trans = "-1 0 0 -1 $media->[2] $media->[3] cm" if $mediatype eq 'MediaBox'; 1308 } elsif ($rotate == 270) { 1309 $trans = "0 1 -1 0 $media->[3] 0 cm" if $mediatype eq 'MediaBox'; 1310 $media = [$media->[1], $media->[0], $media->[3], $media->[2]]; 1311 } 1312 $page->{$mediatype} = PDFArray(map { PDFNum($_) } @$media); 1313 } 1314 } else { 1315 $trans = ''; 1316 } 1317 } else { 1318 $trans = ''; 1319 } 1320 1321 if (defined $page->{'Contents'} and not $page->{' opened'}) { 1322 $page->fixcontents(); 1323 my $uncontent = delete $page->{'Contents'}; 1324 my $content = $page->gfx(); 1325 $content->add(" $trans "); 1326 1327 if ($self->default('pageencaps')) { 1328 $content->{' stream'} .= ' q '; 1329 } 1330 foreach my $k ($uncontent->elements()) { 1331 $k->realise(); 1332 $content->{' stream'} .= ' ' . unfilter($k->{'Filter'}, $k->{' stream'}) . ' '; 1333 } 1334 if ($self->default('pageencaps')) { 1335 $content->{' stream'} .= ' Q '; 1336 } 1337 1338 # if we like compress we will do it now to do quicker saves 1339 if ($self->{'forcecompress'} eq 'flate' || 1340 $self->{'forcecompress'} =~ m/^[1-9]\d*$/) { 1341 $content->{' stream'} = dofilter($content->{'Filter'}, $content->{' stream'}); 1342 $content->{' nofilt'} = 1; 1343 delete $content->{'-docompress'}; 1344 $content->{'Length'} = PDFNum(length($content->{' stream'})); 1345 } 1346 } 1347 $page->{' opened'} = 1; 1348 } 1349 1350 $self->{'pdf'}->out_obj($page); 1351 $self->{'pdf'}->out_obj($self->{'pages'}); 1352 $page->{' apipdf'} = $self->{'pdf'}; 1353 $page->{' api'} = $self; 1354 weaken $page->{' apipdf'}; 1355 weaken $page->{' api'}; 1356 1357 return $page; 1358} # end of openpage() 1359 1360=item $page = $pdf->openpage($page_number) 1361 1362B<Deprecated.> Will be removed on or after June, 2023. Use C<open_page> call 1363instead. 1364 1365=cut 1366 1367sub openpage { return open_page(@_); } ## no critic 1368 1369# internal utility 1370 1371sub _walk_obj { 1372 my ($object_cache, $source_pdf, $target_pdf, $source_object, @keys) = @_; 1373 1374 if (ref($source_object) =~ /Objind$/) { 1375 $source_object->realise(); 1376 } 1377 1378 return $object_cache->{scalar $source_object} if defined $object_cache->{scalar $source_object}; 1379 #die "infinite loop while copying objects" if $source_object->{' copied'}; 1380 1381 my $target_object = $source_object->copy($source_pdf); ## thanks to: yaheath // Fri, 17 Sep 2004 1382 1383 #$source_object->{' copied'} = 1; 1384 $target_pdf->new_obj($target_object) if $source_object->is_obj($source_pdf); 1385 1386 $object_cache->{scalar $source_object} = $target_object; 1387 1388 if (ref($source_object) =~ /Array$/) { 1389 $target_object->{' val'} = []; 1390 foreach my $k ($source_object->elements()) { 1391 $k->realise() if ref($k) =~ /Objind$/; 1392 $target_object->add_elements(_walk_obj($object_cache, $source_pdf, $target_pdf, $k)); 1393 } 1394 } elsif (ref($source_object) =~ /Dict$/) { 1395 @keys = keys(%$target_object) unless scalar @keys; 1396 foreach my $k (@keys) { 1397 next if $k =~ /^ /; 1398 next unless defined $source_object->{$k}; 1399 $target_object->{$k} = _walk_obj($object_cache, $source_pdf, $target_pdf, $source_object->{$k}); 1400 } 1401 if ($source_object->{' stream'}) { 1402 if ($target_object->{'Filter'}) { 1403 $target_object->{' nofilt'} = 1; 1404 } else { 1405 delete $target_object->{' nofilt'}; 1406 $target_object->{'Filter'} = PDFArray(PDFName('FlateDecode')); 1407 } 1408 $target_object->{' stream'} = $source_object->{' stream'}; 1409 } 1410 } 1411 delete $target_object->{' streamloc'}; 1412 delete $target_object->{' streamsrc'}; 1413 1414 return $target_object; 1415} # end of _walk_obj() 1416 1417=item $xoform = $pdf->importPageIntoForm($source_pdf, $source_page_number) 1418 1419Returns a Form XObject created by extracting the specified page from 1420$source_pdf. 1421 1422This is useful if you want to transpose the imported page somewhat 1423differently onto a page (e.g. two-up, four-up, etc.). 1424 1425If $source_page_number is 0 or -1, it will return the last page in the 1426document. 1427 1428B<Example:> 1429 1430 $pdf = PDF::Builder->new(); 1431 $old = PDF::Builder->open('our/old.pdf'); 1432 $page = $pdf->page(); 1433 $gfx = $page->gfx(); 1434 1435 # Import Page 2 from the old PDF 1436 $xo = $pdf->importPageIntoForm($old, 2); 1437 1438 # Add it to the new PDF's first page at 1/2 scale 1439 $gfx->formimage($xo, 0, 0, 0.5); 1440 1441 $pdf->saveas('our/new.pdf'); 1442 1443B<Note:> You can only import a page from an existing PDF file. 1444 1445=cut 1446 1447sub importPageIntoForm { 1448 my ($self, $s_pdf, $s_idx) = @_; 1449 $s_idx ||= 0; 1450 1451 unless (ref($s_pdf) and $s_pdf->isa('PDF::Builder')) { 1452 die "Invalid usage: first argument must be PDF::Builder instance, not: " . ref($s_pdf); 1453 } 1454 1455 my ($s_page, $xo); 1456 1457 $xo = $self->xo_form(); 1458 1459 if (ref($s_idx) eq 'PDF::Builder::Page') { 1460 $s_page = $s_idx; 1461 } else { 1462 $s_page = $s_pdf->open_page($s_idx); 1463 } 1464 1465 $self->{'apiimportcache'} ||= {}; 1466 $self->{'apiimportcache'}->{$s_pdf} ||= {}; 1467 1468 # This should never get past MediaBox, since it's a required object. 1469 foreach my $k (qw(MediaBox ArtBox TrimBox BleedBox CropBox)) { 1470 #next unless defined $s_page->{$k}; 1471 #my $box = _walk_obj($self->{'apiimportcache'}->{$s_pdf}, $s_pdf->{'pdf'}, $self->{'pdf'}, $s_page->{$k}); 1472 next unless defined $s_page->find_prop($k); 1473 my $box = _walk_obj($self->{'apiimportcache'}->{$s_pdf}, $s_pdf->{'pdf'}, $self->{'pdf'}, $s_page->find_prop($k)); 1474 $xo->bbox(map { $_->val() } $box->elements()); 1475 last; 1476 } 1477 $xo->bbox(0,0, 612,792) unless defined $xo->{'BBox'}; # US Letter default 1478 1479 foreach my $k (qw(Resources)) { 1480 $s_page->{$k} = $s_page->find_prop($k); 1481 next unless defined $s_page->{$k}; 1482 $s_page->{$k}->realise() if ref($s_page->{$k}) =~ /Objind$/; 1483 1484 foreach my $sk (qw(XObject ExtGState Font ProcSet Properties ColorSpace Pattern Shading)) { 1485 next unless defined $s_page->{$k}->{$sk}; 1486 $s_page->{$k}->{$sk}->realise() if ref($s_page->{$k}->{$sk}) =~ /Objind$/; 1487 foreach my $ssk (keys %{$s_page->{$k}->{$sk}}) { 1488 next if $ssk =~ /^ /; 1489 $xo->resource($sk, $ssk, _walk_obj($self->{'apiimportcache'}->{$s_pdf}, $s_pdf->{'pdf'}, $self->{'pdf'}, $s_page->{$k}->{$sk}->{$ssk})); 1490 } 1491 } 1492 } 1493 1494 # create a whole content stream 1495 ## technically it is possible to submit an unfinished 1496 ## (e.g., newly created) source-page, but that's nonsense, 1497 ## so we expect a page fixed by open_page and die otherwise 1498 unless ($s_page->{' opened'}) { 1499 croak join(' ', 1500 "Pages may only be imported from a complete PDF.", 1501 "Save and reopen the source PDF object first."); 1502 } 1503 1504 if (defined $s_page->{'Contents'}) { 1505 $s_page->fixcontents(); 1506 1507 $xo->{' stream'} = ''; 1508 # open_page pages only contain one stream 1509 my ($k) = $s_page->{'Contents'}->elements(); 1510 $k->realise(); 1511 if ($k->{' nofilt'}) { 1512 # we have a finished stream here, so we unfilter 1513 $xo->add('q', unfilter($k->{'Filter'}, $k->{' stream'}), 'Q'); 1514 } else { 1515 # stream is an unfinished/unfiltered content 1516 # so we just copy it and add the required "qQ" 1517 $xo->add('q', $k->{' stream'}, 'Q'); 1518 } 1519 $xo->compressFlate() if $self->{'forcecompress'} eq 'flate' || 1520 $self->{'forcecompress'} =~ m/^[1-9]\d*$/; 1521 } 1522 1523 return $xo; 1524} # end of importPageIntoForm() 1525 1526=item $page = $pdf->import_page($source_pdf) 1527 1528=item $page = $pdf->import_page($source_pdf, $source_page_number) 1529 1530=item $page = $pdf->import_page($source_pdf, $source_page_number, $target_page_number) 1531 1532=item $page = $pdf->import_page($source_pdf, $source_page_number, $target_page_object) 1533 1534Imports a page from $source_pdf and adds it to the specified position 1535in $pdf. 1536 1537If the C<$source_page_number> is omitted, 0, or -1; the last page of the 1538source is imported. 1539If the C<$target_page_number> is omitted, 0, or -1; the imported page will be 1540placed as the new last page of the target (C<$pdf>). 1541Otherwise, as with the C<page()> method, the page will be inserted before an 1542existing page of that number. 1543 1544B<Note:> If you pass a page I<object> instead of a page I<number> for 1545C<$target_page_number>, the contents of the page will be B<merged> into the 1546existing page. 1547 1548B<Example:> 1549 1550 $pdf = PDF::Builder->new(); 1551 $old = PDF::Builder->open('our/old.pdf'); 1552 1553 # Add page 2 from the old PDF as page 1 of the new PDF 1554 $page = $pdf->import_page($old, 2); 1555 1556 $pdf->saveas('our/new.pdf'); 1557 1558B<Note:> You can only import a page from an existing PDF file. 1559 1560=cut 1561 1562# importpage() renamed to import_page() 1563 1564sub import_page { 1565 my ($self, $s_pdf, $s_idx, $t_idx) = @_; 1566 1567 $s_idx ||= 0; # default to last page 1568 $t_idx ||= 0; # default to last page 1569 my ($s_page, $t_page); 1570 1571 unless (ref($s_pdf) and $s_pdf->isa('PDF::Builder')) { 1572 die "Invalid usage: first argument must be PDF::Builder instance, not: " . ref($s_pdf); 1573 } 1574 1575 if (ref($s_idx) eq 'PDF::Builder::Page') { 1576 $s_page = $s_idx; 1577 } else { 1578 $s_page = $s_pdf->open_page($s_idx); 1579 } 1580 1581 if (ref($t_idx) eq 'PDF::Builder::Page') { 1582 $t_page = $t_idx; 1583 } else { 1584 if ($self->pages() < $t_idx) { 1585 $t_page = $self->page(); 1586 } else { 1587 $t_page = $self->page($t_idx); 1588 } 1589 } 1590 1591 $self->{'apiimportcache'} = $self->{'apiimportcache'} || {}; 1592 $self->{'apiimportcache'}->{$s_pdf} = $self->{'apiimportcache'}->{$s_pdf} || {}; 1593 1594 # we now import into a form to keep 1595 # all those nasty resources from polluting 1596 # our very own resource naming space. 1597 my $xo = $self->importPageIntoForm($s_pdf, $s_page); 1598 1599 # copy all page dimensions 1600 foreach my $k (qw(MediaBox ArtBox TrimBox BleedBox CropBox)) { 1601 my $prop = $s_page->find_prop($k); 1602 next unless defined $prop; 1603 1604 my $box = _walk_obj({}, $s_pdf->{'pdf'}, $self->{'pdf'}, $prop); 1605 my $method = lc $k; 1606 1607 $t_page->$method(map { $_->val() } $box->elements()); 1608 } 1609 1610 $t_page->gfx()->formimage($xo, 0, 0, 1); 1611 1612 # copy annotations and/or form elements as well 1613 if (exists $s_page->{'Annots'} and $s_page->{'Annots'} and $self->{'copyannots'}) { 1614 # first set up the AcroForm, if required 1615 my $AcroForm; 1616 if (my $a = $s_pdf->{'pdf'}->{'Root'}->realise()->{'AcroForm'}) { 1617 $a->realise(); 1618 1619 $AcroForm = _walk_obj({}, $s_pdf->{'pdf'}, $self->{'pdf'}, $a, qw(NeedAppearances SigFlags CO DR DA Q)); 1620 } 1621 my @Fields = (); 1622 my @Annots = (); 1623 foreach my $a ($s_page->{'Annots'}->elements()) { 1624 $a->realise(); 1625 my $t_a = PDFDict(); 1626 $self->{'pdf'}->new_obj($t_a); 1627 # these objects are likely to be both annotations and Acroform fields 1628 # key names are copied from PDF Reference 1.4 (Tables) 1629 my @k = ( 1630 qw( Type Subtype Contents P Rect NM M F BS Border AP AS C CA T Popup A AA StructParent Rotate 1631 ), # Annotations - Common (8.10) 1632 qw( Subtype Contents Open Name ), # Text Annotations (8.15) 1633 qw( Subtype Contents Dest H PA ), # Link Annotations (8.16) 1634 qw( Subtype Contents DA Q ), # Free Text Annotations (8.17) 1635 qw( Subtype Contents L BS LE IC ), # Line Annotations (8.18) 1636 qw( Subtype Contents BS IC ), # Square and Circle Annotations (8.20) 1637 qw( Subtype Contents QuadPoints ), # Markup Annotations (8.21) 1638 qw( Subtype Contents Name ), # Rubber Stamp Annotations (8.22) 1639 qw( Subtype Contents InkList BS ), # Ink Annotations (8.23) 1640 qw( Subtype Contents Parent Open ), # Popup Annotations (8.24) 1641 qw( Subtype FS Contents Name ), # File Attachment Annotations (8.25) 1642 qw( Subtype Sound Contents Name ), # Sound Annotations (8.26) 1643 qw( Subtype Movie Contents A ), # Movie Annotations (8.27) 1644 qw( Subtype Contents H MK ), # Widget Annotations (8.28) 1645 # Printers Mark Annotations (none) 1646 # Trap Network Annotations (none) 1647 ); 1648 push @k, ( 1649 qw( Subtype FT Parent Kids T TU TM Ff V DV AA 1650 ), # Fields - Common (8.49) 1651 qw( DR DA Q ), # Fields containing variable text (8.51) 1652 qw( Opt ), # Checkbox field (8.54) 1653 qw( Opt ), # Radio field (8.55) 1654 qw( MaxLen ), # Text field (8.57) 1655 qw( Opt TI I ), # Choice field (8.59) 1656 ) if $AcroForm; 1657 1658 # sorting out dupes 1659 my %ky = map { $_ => 1 } @k; 1660 # we do P separately, as it points to the page the Annotation is on 1661 delete $ky{'P'}; 1662 # copy everything else 1663 foreach my $k (keys %ky) { 1664 next unless defined $a->{$k}; 1665 $a->{$k}->realise(); 1666 $t_a->{$k} = _walk_obj({}, $s_pdf->{'pdf'}, $self->{'pdf'}, $a->{$k}); 1667 } 1668 $t_a->{'P'} = $t_page; 1669 push @Annots, $t_a; 1670 push @Fields, $t_a if ($AcroForm and $t_a->{'Subtype'}->val() eq 'Widget'); 1671 } 1672 $t_page->{'Annots'} = PDFArray(@Annots); 1673 $AcroForm->{'Fields'} = PDFArray(@Fields) if $AcroForm; 1674 $self->{'pdf'}->{'Root'}->{'AcroForm'} = $AcroForm; 1675 } 1676 $t_page->{' imported'} = 1; 1677 1678 $self->{'pdf'}->out_obj($t_page); 1679 $self->{'pdf'}->out_obj($self->{'pages'}); 1680 1681 return $t_page; 1682} # end of import_page() 1683 1684=item $count = $pdf->pages() 1685 1686Returns the number of pages in the document. 1687 1688=cut 1689 1690sub pages { 1691 my $self = shift(); 1692 return scalar @{$self->{'pagestack'}}; 1693} 1694 1695# set global User Unit scale factor (default 1.0) 1696 1697=item $pdf->userunit($value) 1698 1699Sets the global UserUnit, defining the scale factor to multiply any size or 1700coordinate by. For example, C<userunit(72)> results in a User Unit of 72 points, 1701or 1 inch. 1702 1703See L<PDF::Builder::Docs/User Units> for more information. 1704 1705=cut 1706 1707sub userunit { 1708 my ($self, $value) = @_; 1709 1710 if (float($value) <= 0.0) { 1711 warn "Invalid User Unit value '$value', set to 1.0"; 1712 $value = 1.0; 1713 } 1714 1715 PDF::Builder->verCheckOutput(1.6, "set User Unit"); 1716 $self->{'pdf'}->{' userUnit'} = float($value); 1717 $self->{'pages'}->{'UserUnit'} = PDFNum(float($value)); 1718 if (defined $self->{'pages'}->{'MediaBox'}) { # should be default letter 1719 if ($value != 1.0) { # divide points by User Unit 1720 my @corners = ( 0, 0, 612/$value, 792/$value ); 1721 $self->{'pages'}->{'MediaBox'} = PDFArray( map { PDFNum(float($_)) } @corners ); 1722 } 1723 } 1724 1725 return $self; 1726} 1727 1728# utility to handle calling page_size, and name with or without -orient setting 1729sub _bbox { 1730 my ($self, @corners) = @_; 1731 1732 # if 1 or 3 elements in @corners, and [0] contains a letter, it's a name 1733 my $isName = 0; 1734 if (scalar @corners && $corners[0] =~ m/[a-z]/i) { $isName = 1; } 1735 1736 if (scalar @corners == 3) { 1737 # name plus one option (-orient) 1738 my ($name, %opts) = @corners; 1739 @corners = page_size(($name)); # now 4 numeric values 1740 if (defined $opts{'-orient'}) { 1741 if ($opts{'-orient'} =~ m/^l/i) { # 'landscape' or just 'l' 1742 # 0 0 W H -> 0 0 H W 1743 my $temp; 1744 $temp = $corners[2]; $corners[2] = $corners[3]; $corners[3] = $temp; 1745 } 1746 } 1747 } else { 1748 # name without [-orient] option, or numeric coordinates given 1749 @corners = page_size(@corners); 1750 } 1751 1752 my $UU = $self->{'pdf'}->{' userUnit'}; 1753 # scale down size if User Unit given (e.g., Letter => 0 0 8.5 11) 1754 if ($isName && $UU != 1.0) { 1755 for (my $i=0; $i<4; $i++) { 1756 $corners[$i] /= $UU; 1757 } 1758 } 1759 1760 return (@corners); 1761} # end of _bbox() 1762 1763# utility to get a bounding box by name 1764sub _get_bbox { 1765 my ($self, $boxname) = @_; 1766 1767 # if requested box not set, return next higher box's corners 1768 # MediaBox should always at least have a default value 1769 if (not defined $self->{'pages'}->{$boxname}) { 1770 if ($boxname eq 'CropBox') { 1771 $boxname = 'MediaBox'; 1772 } elsif ($boxname eq 'BleedBox' || 1773 $boxname eq 'TrimBox' || 1774 $boxname eq 'ArtBox' ) { 1775 if (defined $self->{'pages'}->{'CropBox'}) { 1776 $boxname = 'CropBox'; 1777 } else { 1778 $boxname = 'MediaBox'; 1779 } 1780 } else { 1781 # invalid box name (silent error). just use MediaBox 1782 $boxname = 'MediaBox'; 1783 } 1784 } 1785 1786 # now $boxname is known to exist 1787 return map { $_->val() } $self->{'pages'}->{$boxname}->elements(); 1788 1789} # end of _get_bbox() 1790 1791=item $pdf->mediabox($name) 1792 1793=item $pdf->mediabox($name, -orient => 'orientation') 1794 1795=item $pdf->mediabox($w,$h) 1796 1797=item $pdf->mediabox($llx,$lly, $urx,$ury) 1798 1799=item ($llx,$lly, $urx,$ury) = $pdf->mediabox() 1800 1801Sets (or gets) the global MediaBox, defining the width and height (or by 1802corner coordinates, or by standard name) of the output page itself, such as 1803the physical paper size. 1804 1805See L<PDF::Builder::Docs/Media Box> for more information. 1806The method always returns the current bounds (after any set operation). 1807 1808=cut 1809 1810sub mediabox { 1811 my ($self, @corners) = @_; 1812 if (defined $corners[0]) { 1813 @corners = $self->_bbox(@corners); 1814 $self->{'pages'}->{'MediaBox'} = PDFArray( map { PDFNum(float($_)) } @corners ); 1815 } 1816 1817 return $self->_get_bbox('MediaBox'); 1818} 1819 1820=item $pdf->cropbox($name) 1821 1822=item $pdf->cropbox($name, -orient => 'orientation') 1823 1824=item $pdf->cropbox($w,$h) 1825 1826=item $pdf->cropbox($llx,$lly, $urx,$ury) 1827 1828=item ($llx,$lly, $urx,$ury) = $pdf->cropbox() 1829 1830Sets (or gets) the global CropBox. This will define the media size to which 1831the output will later be clipped. 1832 1833See L<PDF::Builder::Docs/Crop Box> for more information. 1834The method always returns the current bounds (after any set operation). 1835 1836=cut 1837 1838sub cropbox { 1839 my ($self, @corners) = @_; 1840 if (defined $corners[0]) { 1841 @corners = $self->_bbox(@corners); 1842 $self->{'pages'}->{'CropBox'} = PDFArray( map { PDFNum(float($_)) } @corners ); 1843 } 1844 1845 return $self->_get_bbox('CropBox'); 1846} 1847 1848=item $pdf->bleedbox($name) 1849 1850=item $pdf->bleedbox($name, -orient => 'orientation') 1851 1852=item $pdf->bleedbox($w,$h) 1853 1854=item $pdf->bleedbox($llx,$lly, $urx,$ury) 1855 1856=item ($llx,$lly, $urx,$ury) = $pdf->bleedbox() 1857 1858Sets (or gets) the global BleedBox. This is typically used for hard copy 1859printing where you want ink to go to the edge of the cut paper. 1860 1861See L<PDF::Builder::Docs/Bleed Box> for more information. 1862The method always returns the current bounds (after any set operation). 1863 1864=cut 1865 1866sub bleedbox { 1867 my ($self, @corners) = @_; 1868 if (defined $corners[0]) { 1869 @corners = $self->_bbox(@corners); 1870 $self->{'pages'}->{'BleedBox'} = PDFArray( map { PDFNum(float($_)) } @corners ); 1871 } 1872 1873 return $self->_get_bbox('BleedBox'); 1874} 1875 1876=item $pdf->trimbox($name) 1877 1878=item $pdf->trimbox($name, -orient => 'orientation') 1879 1880=item $pdf->trimbox($w,$h) 1881 1882=item $pdf->trimbox($llx,$lly, $urx,$ury) 1883 1884=item ($llx,$lly, $urx,$ury) = $pdf->trimbox() 1885 1886Sets (or gets) the global TrimBox. This is supposed to be the actual 1887dimensions of the finished page (after trimming of the paper). 1888 1889See L<PDF::Builder::Docs/Trim Box> for more information. 1890The method always returns the current bounds (after any set operation). 1891 1892=cut 1893 1894sub trimbox { 1895 my ($self, @corners) = @_; 1896 if (defined $corners[0]) { 1897 @corners = $self->_bbox(@corners); 1898 $self->{'pages'}->{'TrimBox'} = PDFArray( map { PDFNum(float($_)) } @corners ); 1899 } 1900 1901 return $self->_get_bbox('TrimBox'); 1902} 1903 1904=item $pdf->artbox($name) 1905 1906=item $pdf->artbox($name, -orient => 'orientation') 1907 1908=item $pdf->artbox($w,$h) 1909 1910=item $pdf->artbox($llx,$lly, $urx,$ury) 1911 1912=item ($llx,$lly, $urx,$ury) = $pdf->artbox() 1913 1914Sets (or gets) the global ArtBox. This is supposed to define "the extent of 1915the page's I<meaningful> content". 1916 1917See L<PDF::Builder::Docs/Art Box> for more information. 1918The method always returns the current bounds (after any set operation). 1919 1920=cut 1921 1922sub artbox { 1923 my ($self, @corners) = @_; 1924 if (defined $corners[0]) { 1925 @corners = $self->_bbox(@corners); 1926 $self->{'pages'}->{'ArtBox'} = PDFArray( map { PDFNum(float($_)) } @corners ); 1927 } 1928 1929 return $self->_get_bbox('ArtBox'); 1930} 1931 1932=back 1933 1934=head1 FONT METHODS 1935 1936=over 1937 1938=item @directories = PDF::Builder::addFontDirs($dir1, $dir2, ...) 1939 1940Adds one or more directories to the search path for finding font 1941files. 1942 1943Returns the list of searched directories. 1944 1945=cut 1946 1947sub addFontDirs { 1948 my @dirs = @_; 1949 push @FontDirs, @dirs; 1950 return @FontDirs; 1951} 1952 1953sub _findFont { 1954 my $font = shift(); 1955 1956 my @fonts = ($font, map { "$_/$font" } @FontDirs); 1957 shift @fonts while scalar(@fonts) and not -f $fonts[0]; 1958 1959 return $fonts[0]; 1960} 1961 1962=item $font = $pdf->corefont($fontname, %options) 1963 1964=item $font = $pdf->corefont($fontname) 1965 1966Returns a new Adobe core font object. For details, see L<PDF::Builder::Docs/Core Fonts>. 1967 1968See also L<PDF::Builder::Resource::Font::CoreFont>. 1969 1970=cut 1971 1972sub corefont { 1973 my ($self, $name, %opts) = @_; 1974 1975 require PDF::Builder::Resource::Font::CoreFont; 1976 my $obj = PDF::Builder::Resource::Font::CoreFont->new($self->{'pdf'}, $name, %opts); 1977 $self->{'pdf'}->out_obj($self->{'pages'}); 1978 $obj->tounicodemap() if $opts{'-unicodemap'}; # UTF-8 not usable 1979 1980 return $obj; 1981} 1982 1983=item $font = $pdf->psfont($ps_file, %options) 1984 1985=item $font = $pdf->psfont($ps_file) 1986 1987Returns a new Adobe Type1 ("PostScript") font object. 1988For details, see L<PDF::Builder::Docs/PS Fonts>. 1989 1990See also L<PDF::Builder::Resource::Font::Postscript>. 1991 1992=cut 1993 1994sub psfont { 1995 my ($self, $psf, %opts) = @_; 1996 1997 foreach my $o (qw(-afmfile -pfmfile)) { 1998 next unless defined $opts{$o}; 1999 $opts{$o} = _findFont($opts{$o}); 2000 } 2001 $psf = _findFont($psf); 2002 require PDF::Builder::Resource::Font::Postscript; 2003 my $obj = PDF::Builder::Resource::Font::Postscript->new($self->{'pdf'}, $psf, %opts); 2004 2005 $self->{'pdf'}->out_obj($self->{'pages'}); 2006 $obj->tounicodemap() if $opts{'-unicodemap'}; # UTF-8 not usable 2007 2008 return $obj; 2009} 2010 2011=item $font = $pdf->ttfont($ttf_file, %options) 2012 2013=item $font = $pdf->ttfont($ttf_file) 2014 2015Returns a new TrueType (or OpenType) font object. 2016For details, see L<PDF::Builder::Docs/TrueType Fonts>. 2017 2018=cut 2019 2020sub ttfont { 2021 my ($self, $file, %opts) = @_; 2022 2023 # PDF::Builder doesn't set BaseEncoding for TrueType fonts, so text 2024 # isn't searchable unless a ToUnicode CMap is included. Include 2025 # the ToUnicode CMap by default, but allow it to be disabled (for 2026 # performance and file size reasons) by setting -unicodemap to 0. 2027 $opts{'-unicodemap'} = 1 unless exists $opts{'-unicodemap'}; 2028 2029 $file = _findFont($file); 2030 require PDF::Builder::Resource::CIDFont::TrueType; 2031 my $obj = PDF::Builder::Resource::CIDFont::TrueType->new($self->{'pdf'}, $file, %opts); 2032 2033 $self->{'pdf'}->out_obj($self->{'pages'}); 2034 $obj->tounicodemap() if $opts{'-unicodemap'}; 2035 2036 return $obj; 2037} 2038 2039=item $font = $pdf->cjkfont($cjkname, %options) 2040 2041=item $font = $pdf->cjkfont($cjkname) 2042 2043Returns a new CJK font object. These are TrueType-like fonts for East Asian 2044languages (Chinese, Japanese, Korean). 2045For details, see L<PDF::Builder::Docs/CJK Fonts>. 2046 2047See also L<PDF::Builder::Resource::CIDFont::CJKFont> 2048 2049=cut 2050 2051sub cjkfont { 2052 my ($self, $name, %opts) = @_; 2053 2054 require PDF::Builder::Resource::CIDFont::CJKFont; 2055 my $obj = PDF::Builder::Resource::CIDFont::CJKFont->new($self->{'pdf'}, $name, %opts); 2056 2057 $self->{'pdf'}->out_obj($self->{'pages'}); 2058 $obj->tounicodemap() if $opts{'-unicodemap'}; 2059 2060 return $obj; 2061} 2062 2063=item $font = $pdf->synfont($basefont, %options) 2064 2065=item $font = $pdf->synfont($basefont) 2066 2067Returns a new synthetic font object. These are modifications to a core (or 2068PS/T1 or TTF/OTF) font, where the font may be replaced by a Type1 or Type3 2069PostScript font. 2070This does not appear to work with CJK fonts (created with C<cjkfont> method). 2071For details, see L<PDF::Builder::Docs/Synthetic Fonts>. 2072 2073See also L<PDF::Builder::Resource::Font::SynFont> 2074 2075=cut 2076 2077sub synfont { 2078 my ($self, $font, %opts) = @_; 2079 2080 # PDF::Builder doesn't set BaseEncoding for TrueType fonts, so text 2081 # isn't searchable unless a ToUnicode CMap is included. Include 2082 # the ToUnicode CMap by default, but allow it to be disabled (for 2083 # performance and file size reasons) by setting -unicodemap to 0. 2084 $opts{'-unicodemap'} = 1 unless exists $opts{'-unicodemap'}; 2085 2086 require PDF::Builder::Resource::Font::SynFont; 2087 my $obj = PDF::Builder::Resource::Font::SynFont->new($self->{'pdf'}, $font, %opts); 2088 2089 $self->{'pdf'}->out_obj($self->{'pages'}); 2090 $obj->tounicodemap() if $opts{'-unicodemap'}; 2091 2092 return $obj; 2093} 2094 2095=item $font = $pdf->bdfont($bdf_file, @options) 2096 2097=item $font = $pdf->bdfont($bdf_file) 2098 2099Returns a new BDF (bitmapped distribution format) font object, based on the 2100specified Adobe BDF file. 2101 2102See also L<PDF::Builder::Resource::Font::BdFont> 2103 2104=cut 2105 2106sub bdfont { 2107 my ($self, $bdf_file, @opts) = @_; 2108 2109 require PDF::Builder::Resource::Font::BdFont; 2110 my $obj = PDF::Builder::Resource::Font::BdFont->new($self->{'pdf'}, $bdf_file, @opts); 2111 2112 $self->{'pdf'}->out_obj($self->{'pages'}); 2113 # $obj->tounicodemap(); # does not support Unicode! 2114 2115 return $obj; 2116} 2117 2118=item $font = $pdf->unifont(@fontspecs, %options) 2119 2120=item $font = $pdf->unifont(@fontspecs) 2121 2122Returns a new uni-font object, based on the specified fonts and options. 2123 2124B<BEWARE:> This is not a true PDF-object, but a virtual/abstract font definition! 2125 2126See also L<PDF::Builder::Resource::UniFont>. 2127 2128Valid %options are: 2129 2130=over 2131 2132=item -encode 2133 2134Changes the encoding of the font from its default. 2135 2136=back 2137 2138=cut 2139 2140sub unifont { 2141 my ($self, @opts) = @_; 2142 2143 require PDF::Builder::Resource::UniFont; 2144 my $obj = PDF::Builder::Resource::UniFont->new($self->{'pdf'}, @opts); 2145 2146 return $obj; 2147} 2148 2149=back 2150 2151=head1 IMAGE METHODS 2152 2153=over 2154 2155=item $jpeg = $pdf->image_jpeg($file) 2156 2157Imports and returns a new JPEG image object. C<$file> may be either a filename 2158or a filehandle. 2159 2160See L<PDF::Builder::Resource::XObject::Image::JPEG> for additional information 2161and C<examples/Content.pl> for some examples of placing an image on a page. 2162 2163=cut 2164 2165# =item $jpeg = $pdf->image_jpeg($file, %options) no current options 2166 2167sub image_jpeg { 2168 my ($self, $file, %opts) = @_; 2169 2170 require PDF::Builder::Resource::XObject::Image::JPEG; 2171 my $obj = PDF::Builder::Resource::XObject::Image::JPEG->new($self->{'pdf'}, $file); 2172 2173 $self->{'pdf'}->out_obj($self->{'pages'}); 2174 2175 return $obj; 2176} 2177 2178=item $tiff = $pdf->image_tiff($file, %opts) 2179 2180=item $tiff = $pdf->image_tiff($file) 2181 2182Imports and returns a new TIFF image object. C<$file> may be either a filename 2183or a filehandle. 2184For details, see L<PDF::Builder::Docs/TIFF Images>. 2185 2186See L<PDF::Builder::Resource::XObject::Image::TIFF> and 2187L<PDF::Builder::Resource::XObject::Image::TIFF_GT> for additional information 2188and C<examples/Content.pl> 2189for some examples of placing an image on a page (JPEG, but the principle is 2190the same). There is an optional TIFF library described, that gives more 2191capability than the default one. 2192 2193=cut 2194 2195sub image_tiff { 2196 my ($self, $file, %opts) = @_; 2197 2198 my ($rc, $obj); 2199 $rc = $self->LA_GT(); 2200 if ($rc) { 2201 # Graphics::TIFF available 2202 if (defined $opts{'-nouseGT'} && $opts{'-nouseGT'} == 1) { 2203 $rc = -1; # don't use it 2204 } 2205 } 2206 if ($rc == 1) { 2207 # Graphics::TIFF (_GT suffix) available and to be used 2208 require PDF::Builder::Resource::XObject::Image::TIFF_GT; 2209 $obj = PDF::Builder::Resource::XObject::Image::TIFF_GT->new($self->{'pdf'}, $file, 'Ix'.pdfkey(), %opts); 2210 $self->{'pdf'}->out_obj($self->{'pages'}); 2211 } else { 2212 # Graphics::TIFF not available, or is but is not to be used 2213 require PDF::Builder::Resource::XObject::Image::TIFF; 2214 $obj = PDF::Builder::Resource::XObject::Image::TIFF->new($self->{'pdf'}, $file, 'Ix'.pdfkey(), %opts); 2215 $self->{'pdf'}->out_obj($self->{'pages'}); 2216 2217 if ($rc == 0 && $MSG_COUNT[0]++ == 0) { 2218 # give warning message once, unless silenced (-silent) or 2219 # deliberately not using Graphics::TIFF (rc == -1) 2220 if (!defined $opts{'-silent'} || $opts{'-silent'} == 0) { 2221 print STDERR "Your system does not have Graphics::TIFF installed, so some\nTIFF functions may not run correctly.\n"; 2222 # even if -silent only once, COUNT still incremented 2223 } 2224 } 2225 } 2226 $obj->{'usesGT'} = PDFNum($rc); # -1 available but unused 2227 # 0 not available 2228 # 1 available and used 2229 # $tiff->usesLib() to get number 2230 2231 return $obj; 2232} 2233 2234=item $rc = $pdf->LA_GT() 2235 2236Returns 1 if the library name (package) Graphics::TIFF is installed, and 22370 otherwise. For this optional library, this call can be used to know if it 2238is safe to use certain functions. For example: 2239 2240 if ($pdf->LA_GT() { 2241 # is installed and usable 2242 } else { 2243 # not available. you will be running the old, pure PERL code 2244 } 2245 2246=cut 2247 2248# there doesn't seem to be a way to pass in a string (or bare) package name, 2249# to make a generic check routine 2250sub LA_GT { 2251 my ($self) = @_; 2252 2253 my ($rc); 2254 $rc = eval { 2255 require Graphics::TIFF; 2256 1; 2257 }; 2258 if (!defined $rc) { $rc = 0; } # else is 1 2259 if ($rc) { 2260 # installed, but not up to date? 2261 if ($Graphics::TIFF::VERSION < $GrTFversion) { $rc = 0; } 2262 } 2263 2264 return $rc; 2265} 2266 2267=item $pnm = $pdf->image_pnm($file) 2268 2269Imports and returns a new PNM image object. C<$file> may be either a filename 2270or a filehandle. 2271 2272See C<examples/Content.pl> 2273for some examples of placing an image on a page (JPEG, but the principle is 2274the same). 2275 2276=cut 2277 2278# =item $pnm = $pdf->image_pnm($file, %options) no current options 2279 2280sub image_pnm { 2281 my ($self, $file, %opts) = @_; 2282 2283 require PDF::Builder::Resource::XObject::Image::PNM; 2284 my $obj = PDF::Builder::Resource::XObject::Image::PNM->new($self->{'pdf'}, $file); 2285 $self->{'pdf'}->out_obj($self->{'pages'}); 2286 2287 return $obj; 2288} 2289 2290=item $png = $pdf->image_png($file, %options) 2291 2292=item $png = $pdf->image_png($file) 2293 2294Imports and returns a new PNG image object. C<$file> may be either 2295a filename or a filehandle. 2296For details, see L<PDF::Builder::Docs/PNG Images>. 2297 2298See L<PDF::Builder::Resource::XObject::Image::PNG> and 2299L<PDF::Builder::Resource::XObject::Image::PNG_IPL> for additional information 2300and C<examples/Content.pl> 2301for some examples of placing an image on a page (JPEG, but the principle is 2302the same). There is an optional PNG library (PNG_IPL) described, that gives more 2303capability than the default one. 2304 2305=cut 2306 2307sub image_png { 2308 my ($self, $file, %opts) = @_; 2309 2310 my ($rc, $obj); 2311 $rc = $self->LA_IPL(); 2312 if ($rc) { 2313 # Image::PNG::Libpng available 2314 if (defined $opts{'-nouseIPL'} && $opts{'-nouseIPL'} == 1) { 2315 $rc = -1; # don't use it 2316 } 2317 } 2318 if ($rc == 1) { 2319 # Image::PNG::Libpng (_IPL suffix) available and to be used 2320 require PDF::Builder::Resource::XObject::Image::PNG_IPL; 2321 $obj = PDF::Builder::Resource::XObject::Image::PNG_IPL->new($self->{'pdf'}, $file, 'Px'.pdfkey(), %opts); 2322 $self->{'pdf'}->out_obj($self->{'pages'}); 2323 } else { 2324 # Image::PNG::Libpng not available, or is but is not to be used 2325 require PDF::Builder::Resource::XObject::Image::PNG; 2326 $obj = PDF::Builder::Resource::XObject::Image::PNG->new($self->{'pdf'}, $file, 'Px'.pdfkey(), %opts); 2327 $self->{'pdf'}->out_obj($self->{'pages'}); 2328 2329 if ($rc == 0 && $MSG_COUNT[1]++ == 0) { 2330 # give warning message once, unless silenced (-silent) or 2331 # deliberately not using Image::PNG::Libpng (rc == -1) 2332 if (!defined $opts{'-silent'} || $opts{'-silent'} == 0) { 2333 print STDERR "Your system does not have Image::PNG::Libpng installed, so some\nPNG functions may not run correctly.\n"; 2334 # even if -silent only once, COUNT still incremented 2335 } 2336 } 2337 } 2338 $obj->{'usesIPL'} = PDFNum($rc); # -1 available but unused 2339 # 0 not available 2340 # 1 available and used 2341 # $png->usesLib() to get number 2342 return $obj; 2343} 2344 2345=item $rc = $pdf->LA_IPL() 2346 2347Returns 1 if the library name (package) Image::PNG::Libpng is installed, and 23480 otherwise. For this optional library, this call can be used to know if it 2349is safe to use certain functions. For example: 2350 2351 if ($pdf->LA_IPL() { 2352 # is installed and usable 2353 } else { 2354 # not available. don't use 16bps or interlaced PNG image files 2355 } 2356 2357=cut 2358 2359# there doesn't seem to be a way to pass in a string (or bare) package name, 2360# to make a generic check routine 2361sub LA_IPL { 2362 my ($self) = @_; 2363 2364 my ($rc); 2365 $rc = eval { 2366 require Image::PNG::Libpng; 2367 1; 2368 }; 2369 if (!defined $rc) { $rc = 0; } # else is 1 2370 if ($rc) { 2371 # installed, but not up to date? 2372 if ($Image::PNG::Libpng::VERSION < $LpngVersion) { $rc = 0; } 2373 } 2374 2375 return $rc; 2376} 2377 2378=item $gif = $pdf->image_gif($file) 2379 2380Imports and returns a new GIF image object. C<$file> may be either a filename 2381or a filehandle. 2382 2383See L<PDF::Builder::Resource::XObject::Image::GIF> for additional information 2384and C<examples/Content.pl> for some examples of placing an image on a page 2385(JPEG, but the principle is the same). 2386 2387=cut 2388 2389# =item $gif = $pdf->image_gif($file, %options) no current options 2390 2391sub image_gif { 2392 my ($self, $file, %opts) = @_; 2393 2394 require PDF::Builder::Resource::XObject::Image::GIF; 2395 my $obj = PDF::Builder::Resource::XObject::Image::GIF->new($self->{'pdf'}, $file); 2396 $self->{'pdf'}->out_obj($self->{'pages'}); 2397 2398 return $obj; 2399} 2400 2401=item $gdf = $pdf->image_gd($gd_object, %options) 2402 2403=item $gdf = $pdf->image_gd($gd_object) 2404 2405Imports and returns a new image object from Image::GD. 2406 2407Valid %options are: 2408 2409=over 2410 2411=item -lossless => 1 2412 2413Use lossless compression. 2414 2415=back 2416 2417See L<PDF::Builder::Resource::XObject::Image::GD> for additional information 2418and C<examples/Content.pl> for some examples of placing an image on a page 2419(JPEG, but the principle is the same). 2420 2421=cut 2422 2423sub image_gd { 2424 my ($self, $gd, %options) = @_; 2425 2426 require PDF::Builder::Resource::XObject::Image::GD; 2427 my $obj = PDF::Builder::Resource::XObject::Image::GD->new($self->{'pdf'}, $gd, undef, %options); 2428 $self->{'pdf'}->out_obj($self->{'pages'}); 2429 2430 return $obj; 2431} 2432 2433=back 2434 2435=head1 COLORSPACE METHODS 2436 2437=over 2438 2439=item $cs = $pdf->colorspace_act($file) 2440 2441Returns a new colorspace object based on an Adobe Color Table file. 2442 2443See L<PDF::Builder::Resource::ColorSpace::Indexed::ACTFile> for a 2444reference to the file format's specification. 2445 2446=cut 2447 2448# =item $cs = $pdf->colorspace_act($file, %options) no current options 2449 2450sub colorspace_act { 2451 my ($self, $file, %opts) = @_; 2452 2453 require PDF::Builder::Resource::ColorSpace::Indexed::ACTFile; 2454 my $obj = PDF::Builder::Resource::ColorSpace::Indexed::ACTFile->new($self->{'pdf'}, $file); 2455 $self->{'pdf'}->out_obj($self->{'pages'}); 2456 2457 return $obj; 2458} 2459 2460=item $cs = $pdf->colorspace_web() 2461 2462Returns a new colorspace-object based on the "web-safe" color palette. 2463 2464=cut 2465 2466# =item $cs = $pdf->colorspace_web($file, %options) no current options 2467# =item $cs = $pdf->colorspace_web($file) no current file 2468 2469sub colorspace_web { 2470 my ($self, $file, %opts) = @_; 2471 2472 require PDF::Builder::Resource::ColorSpace::Indexed::WebColor; 2473 my $obj = PDF::Builder::Resource::ColorSpace::Indexed::WebColor->new($self->{'pdf'}); 2474 2475 $self->{'pdf'}->out_obj($self->{'pages'}); 2476 2477 return $obj; 2478} 2479 2480=item $cs = $pdf->colorspace_hue() 2481 2482Returns a new colorspace-object based on the hue color palette. 2483 2484See L<PDF::Builder::Resource::ColorSpace::Indexed::Hue> for an explanation. 2485 2486=cut 2487 2488# =item $cs = $pdf->colorspace_hue($file, %options) no current options 2489# =item $cs = $pdf->colorspace_hue($file) no current file 2490 2491sub colorspace_hue { 2492 my ($self, $file, %opts) = @_; 2493 2494 require PDF::Builder::Resource::ColorSpace::Indexed::Hue; 2495 my $obj = PDF::Builder::Resource::ColorSpace::Indexed::Hue->new($self->{'pdf'}); 2496 $self->{'pdf'}->out_obj($self->{'pages'}); 2497 2498 return $obj; 2499} 2500 2501=item $cs = $pdf->colorspace_separation($tint, $color) 2502 2503Returns a new separation colorspace object based on the parameters. 2504 2505I<$tint> can be any valid ink identifier, including but not limited 2506to: 'Cyan', 'Magenta', 'Yellow', 'Black', 'Red', 'Green', 'Blue' or 2507'Orange'. 2508 2509I<$color> must be a valid color specification limited to: '#rrggbb', 2510'!hhssvv', '%ccmmyykk' or a "named color" (rgb). 2511 2512The colorspace model will automatically be chosen based on the 2513specified color. 2514 2515=cut 2516 2517sub colorspace_separation { 2518 my ($self, $tint, @clr) = @_; 2519 2520 require PDF::Builder::Resource::ColorSpace::Separation; 2521 my $obj = PDF::Builder::Resource::ColorSpace::Separation->new($self->{'pdf'}, pdfkey(), $tint, @clr); 2522 $self->{'pdf'}->out_obj($self->{'pages'}); 2523 2524 return $obj; 2525} 2526 2527=item $cs = $pdf->colorspace_devicen(\@tintCSx, $samples) 2528 2529=item $cs = $pdf->colorspace_devicen(\@tintCSx) 2530 2531Returns a new DeviceN colorspace object based on the parameters. 2532 2533B<Example:> 2534 2535 $cy = $pdf->colorspace_separation('Cyan', '%f000'); 2536 $ma = $pdf->colorspace_separation('Magenta', '%0f00'); 2537 $ye = $pdf->colorspace_separation('Yellow', '%00f0'); 2538 $bk = $pdf->colorspace_separation('Black', '%000f'); 2539 2540 $pms023 = $pdf->colorspace_separation('PANTONE 032CV', '%0ff0'); 2541 2542 $dncs = $pdf->colorspace_devicen( [ $cy,$ma,$ye,$bk, $pms023 ] ); 2543 2544The colorspace model will automatically be chosen based on the first 2545colorspace specified. 2546 2547=cut 2548 2549sub colorspace_devicen { 2550 my ($self, $clrs, $samples) = @_; 2551 $samples ||= 2; 2552 2553 require PDF::Builder::Resource::ColorSpace::DeviceN; 2554 my $obj = PDF::Builder::Resource::ColorSpace::DeviceN->new($self->{'pdf'}, pdfkey(), $clrs, $samples); 2555 $self->{'pdf'}->out_obj($self->{'pages'}); 2556 2557 return $obj; 2558} 2559 2560=back 2561 2562=head1 BARCODE METHODS 2563 2564These are glue routines to the actual barcode rendering routines found 2565elsewhere. 2566 2567=over 2568 2569=item $bc = $pdf->xo_codabar(%options) 2570 2571=item $bc = $pdf->xo_code128(%options) 2572 2573=item $bc = $pdf->xo_2of5int(%options) 2574 2575=item $bc = $pdf->xo_3of9(%options) 2576 2577=item $bc = $pdf->xo_ean13(%options) 2578 2579Creates the specified barcode object as a form XObject. 2580 2581=cut 2582 2583# TBD consider moving these to a BarCodes subdirectory, as the number of bar 2584# code routines increases 2585 2586sub xo_code128 { 2587 my ($self, @options) = @_; 2588 2589 require PDF::Builder::Resource::XObject::Form::BarCode::code128; 2590 my $obj = PDF::Builder::Resource::XObject::Form::BarCode::code128->new($self->{'pdf'}, @options); 2591 $self->{'pdf'}->out_obj($self->{'pages'}); 2592 2593 return $obj; 2594} 2595 2596sub xo_codabar { 2597 my ($self, @options) = @_; 2598 2599 require PDF::Builder::Resource::XObject::Form::BarCode::codabar; 2600 my $obj = PDF::Builder::Resource::XObject::Form::BarCode::codabar->new($self->{'pdf'}, @options); 2601 $self->{'pdf'}->out_obj($self->{'pages'}); 2602 2603 return $obj; 2604} 2605 2606sub xo_2of5int { 2607 my ($self, @options) = @_; 2608 2609 require PDF::Builder::Resource::XObject::Form::BarCode::int2of5; 2610 my $obj = PDF::Builder::Resource::XObject::Form::BarCode::int2of5->new($self->{'pdf'}, @options); 2611 $self->{'pdf'}->out_obj($self->{'pages'}); 2612 2613 return $obj; 2614} 2615 2616sub xo_3of9 { 2617 my ($self, @options) = @_; 2618 2619 require PDF::Builder::Resource::XObject::Form::BarCode::code3of9; 2620 my $obj = PDF::Builder::Resource::XObject::Form::BarCode::code3of9->new($self->{'pdf'}, @options); 2621 $self->{'pdf'}->out_obj($self->{'pages'}); 2622 2623 return $obj; 2624} 2625 2626sub xo_ean13 { 2627 my ($self, @options) = @_; 2628 2629 require PDF::Builder::Resource::XObject::Form::BarCode::ean13; 2630 my $obj = PDF::Builder::Resource::XObject::Form::BarCode::ean13->new($self->{'pdf'}, @options); 2631 $self->{'pdf'}->out_obj($self->{'pages'}); 2632 2633 return $obj; 2634} 2635 2636=back 2637 2638=head1 OTHER METHODS 2639 2640=over 2641 2642=item $xo = $pdf->xo_form() 2643 2644Returns a new form XObject. 2645 2646=cut 2647 2648sub xo_form { 2649 my $self = shift(); 2650 2651 my $obj = PDF::Builder::Resource::XObject::Form::Hybrid->new($self->{'pdf'}); 2652 $self->{'pdf'}->out_obj($self->{'pages'}); 2653 2654 return $obj; 2655} 2656 2657=item $egs = $pdf->egstate() 2658 2659Returns a new extended graphics state object. 2660 2661=cut 2662 2663sub egstate { 2664 my $self = shift(); 2665 2666 my $obj = PDF::Builder::Resource::ExtGState->new($self->{'pdf'}, pdfkey()); 2667 $self->{'pdf'}->out_obj($self->{'pages'}); 2668 2669 return $obj; 2670} 2671 2672=item $obj = $pdf->pattern(%options) 2673 2674=item $obj = $pdf->pattern() 2675 2676Returns a new pattern object. 2677 2678=cut 2679 2680sub pattern { 2681 my ($self, %options) = @_; 2682 2683 my $obj = PDF::Builder::Resource::Pattern->new($self->{'pdf'}, undef, %options); 2684 $self->{'pdf'}->out_obj($self->{'pages'}); 2685 2686 return $obj; 2687} 2688 2689=item $obj = $pdf->shading(%options) 2690 2691=item $obj = $pdf->shading() 2692 2693Returns a new shading object. 2694 2695=cut 2696 2697sub shading { 2698 my ($self, %options) = @_; 2699 2700 my $obj = PDF::Builder::Resource::Shading->new($self->{'pdf'}, undef, %options); 2701 $self->{'pdf'}->out_obj($self->{'pages'}); 2702 2703 return $obj; 2704} 2705 2706=item $otls = $pdf->outlines() 2707 2708Returns a new or existing outlines object. 2709 2710=cut 2711 2712sub outlines { 2713 my $self = shift(); 2714 2715 require PDF::Builder::Outlines; 2716 $self->{'pdf'}->{'Root'}->{'Outlines'} ||= PDF::Builder::Outlines->new($self); 2717 2718 my $obj = $self->{'pdf'}->{'Root'}->{'Outlines'}; 2719# bless $obj, 'PDF::Builder::Outlines'; 2720# $obj->{' apipdf'} = $self->{'pdf'}; 2721# $obj->{' api'} = $self; 2722# weaken $obj->{' apipdf'}; 2723# weaken $obj->{' api'}; 2724 2725 $self->{'pdf'}->new_obj($obj) unless $obj->is_obj($self->{'pdf'}); 2726 $self->{'pdf'}->out_obj($obj); 2727 $self->{'pdf'}->out_obj($self->{'pdf'}->{'Root'}); 2728 2729 return $obj; 2730} 2731 2732=item $ndest = $pdf->named_destination() 2733 2734Returns a new or existing named destination object. 2735 2736=cut 2737 2738sub named_destination { 2739 my ($self, $cat, $name, $obj) = @_; 2740 my $root = $self->{'catalog'}; 2741 2742 $root->{'Names'} ||= PDFDict(); 2743 $root->{'Names'}->{$cat} ||= PDFDict(); 2744 $root->{'Names'}->{$cat}->{'-vals'} ||= {}; 2745 $root->{'Names'}->{$cat}->{'Limits'} ||= PDFArray(); 2746 $root->{'Names'}->{$cat}->{'Names'} ||= PDFArray(); 2747 2748 unless (defined $obj) { 2749 $obj = PDF::Builder::NamedDestination->new($self->{'pdf'}); 2750 } 2751 $root->{'Names'}->{$cat}->{'-vals'}->{$name} = $obj; 2752 2753 my @names = sort {$a cmp $b} keys %{$root->{'Names'}->{$cat}->{'-vals'}}; 2754 2755 $root->{'Names'}->{$cat}->{'Limits'}->{' val'}->[0] = PDFString($names[0], 'n'); 2756 $root->{'Names'}->{$cat}->{'Limits'}->{' val'}->[1] = PDFString($names[-1], 'n'); 2757 2758 @{$root->{'Names'}->{$cat}->{'Names'}->{' val'}} = (); 2759 2760 foreach my $k (@names) { 2761 push @{$root->{'Names'}->{$cat}->{'Names'}->{' val'}}, 2762 ( PDFString($k, 'n'), 2763 $root->{'Names'}->{$cat}->{'-vals'}->{$k} 2764 ); 2765 } 2766 2767 return $obj; 2768} # end of named_destination() 2769 2770# ================================================== 2771# input: level of checking, PDF as a string 2772# level: 0 just return with any version override 2773# 1 return version override, and errors 2774# 2 return version override, and errors and warnings 2775# 3 return version override, plus errors, warnings, notes 2776# 4 like (3), plus dump analysis data 2777# 5 like (4), plus dump $self (PDF) contents 2778# returns any /Version value found in Catalog, last one if multiple ones found, 2779# else undefined 2780 2781sub IntegrityCheck { 2782 my ($self, $level, $string) = @_; 2783 2784 my $level_nodiag = 0; 2785 my $level_error = 1; 2786 my $level_warning = 2; 2787 my $level_note = 3; 2788 my $level_dump = 4; 2789 my $level_dumpself = 5; 2790 2791 my $IC = "PDF Integrity Check:"; 2792 2793 #print "$IC level $level\n" if $level >= $level_error; 2794 my $Version = undef; 2795 my ($Info, $Root, $str, $pos, $Parent, @Kids, @others); 2796 2797 my $idx_defined = 0; # has this object been explicitly defined? 2798 my $idx_refcount = 1; # count of all pointing to this obj except as Kid 2799 my $idx_par_clmd = 2; # other object claiming this object as Kid 2800 my $idx_parent = 3; # this object's /Parent entry 2801 my $idx_kid_cnt = 4; # size of kid_list 2802 my $idx_kid_list = 5; # this object's /Kids list 2803 # intialize each element to [ 0 0 -1 -1 -1 [] ] 2804 2805 return $Version if !length($string); # nothing to examine? 2806 # even if $level 0, still want to get any higher /Version 2807 # build analysis data and issue errors/warnings at appropriate $level 2808 my @major = split /%%EOF/, $string; # typically [0] entire PDF [1] empty 2809 my %objList; 2810 my $update = -1; 2811 foreach (@major) { 2812 # update section number 0, 1, 2... with %%EOF in-between 2813 $update++; 2814 next if !length($_); 2815 2816 # split on "endobj" 2817 my @rawObjects = split /endobj/, $_; 2818 # each element contains an object plus leading stuff, not incl endobj 2819 2820 foreach my $rawObject (@rawObjects) { 2821 next if !length($rawObject); 2822 2823 # remove bulky and unwanted stream...endstream 2824 if ($rawObject =~ m/^(.*)stream\s.*\sendstream(.*)$/s) { 2825 $rawObject = $1.$2; 2826 } 2827 2828 # trim off anything before obj clause. endobj already gone. 2829 if ($rawObject =~ m/^(.*?)\s?(\d+) (\d+) obj\s(.*)$/s || 2830 $rawObject =~ m/^(.*?)\s?(\d+) (\d+) obj(.*)$/s) { 2831 $rawObject = $4; 2832 2833 # found an obj, full string is $rawObject. parse into 2834 # selected fields, build $objList{key} entry. 2835 my $objKey = "$2.$3"; # e.g., 4 0 obj -> 4.0 2836 # if this is a replacement object in an update, clear Parent 2837 # and Kids 2838 if (defined $objList{$objKey} && $update > 0) { 2839 $objList{$objKey}->[$idx_parent] = -1; 2840 $objList{$objKey}->[$idx_kid_cnt] = -1; 2841 $objList{$objKey}->[$idx_kid_list] = []; 2842 } 2843 # might have already created this object element as target 2844 # from another object 2845 if (!defined $objList{$objKey}) { 2846 $objList{$objKey} = [0, 0, -1, -1, -1, []]; 2847 } 2848 # mark object as defined 2849 $objList{$objKey}->[$idx_defined] = 1; 2850 2851 # found an object 2852 # looking for /Parent x y R 2853 # /Kids [ x y R ] 2854 # /Type = /Catalog -> /Version /x.y 2855 # for now, ignoring any /BaseVersion 2856 # all other x y R 2857 # remove from $rawObject as we find a match 2858 2859 # /Parent x y R -> $Parent 2860 if ($rawObject =~ m#/Parent(\s+)(\d+)(\s+)(\d+)(\s+)R#) { 2861 $Parent = "$2.$4"; 2862 $str = "/Parent$1$2$3$4$5R"; 2863 $pos = index $rawObject, $str; 2864 substr($rawObject, $pos, length($str)) = ''; 2865 # TBD realistically, do we need to check for >1 /Parent ? 2866 #if ($objList{$objKey}->[$idx_parent] == -1) { 2867 # first /Parent (should not be more) 2868 $objList{$objKey}->[$idx_parent] = $Parent; 2869 #} else { 2870 # print STDERR "$IC Additional Parent ($Parent) in object $objKey, already list $objList{$objKey}->[$idx_parent] as Parent.\n" if $level >= $level_error; 2871 #} 2872 } 2873 2874 # /Kids [ x y R ] -> @Kids 2875 # should we check for multiple Kids arrays in one object (error)? 2876 if ($rawObject =~ m#/Kids(\s+)\[(.*)\]#) { 2877 $str = "/Kids$1\[$2\]"; 2878 $pos = index $rawObject, $str; 2879 substr($rawObject, $pos, length($str)) = ''; 2880 2881 my $str2 = " $2"; # guarantee a leading \s 2882 @Kids = (); 2883 while (1) { 2884 if ($str2 =~ m#(\s+)(\d+)(\s+)(\d+)(\s+)R#) { 2885 $str = "$1$2$3$4$5R"; 2886 push @Kids, "$2.$4"; 2887 $pos = index $str2, $str; 2888 substr($str2, $pos, length($str)) = ''; 2889 } else { 2890 last; 2891 } 2892 } 2893 # TBD: realistically, any need to check for >1 /Kids? 2894 #if (!scalar(@{$objList{$objKey}->[$idx_kid_list]})) { 2895 # first /Kids (should not be more) 2896 @{$objList{$objKey}->[$idx_kid_list]} = @Kids; 2897 $objList{$objKey}->[$idx_kid_cnt] = scalar(@Kids); 2898 #} else { 2899 # print STDERR "$IC Multiple Kids lists in object $objKey, already list @{$objList{$objKey}->[$idx_kid_list]} as Kids.\n" if $level >= $level_error; 2900 #} 2901 } 2902 2903 # /Type /Catalog -> /Version /x.y -> $Version 2904 # both x and y are normally single digits, but allow room 2905 # just global $Version, assuming that each one physically 2906 # later overrides any earlier ones 2907 if ($rawObject =~ m#/Type(\s+)/Catalog#) { 2908 my $sp1 = $1; 2909 if ($rawObject =~ m#/Version /(\d+)\.(\d+)#) { 2910 $Version = "$1.$2"; 2911 $str = "/Version$sp1/$Version"; 2912 $pos = index $rawObject, $str; 2913 substr($rawObject, $pos, length($str)) = ''; 2914 } 2915 } 2916 2917 # if using cross-reference stream, will find /Root x y R 2918 # and /Info x y R entries in an object of /Type /Xref 2919 # it looks like last ones will win 2920 if ($rawObject =~ m#/Type(\s+)/XRef# || 2921 $rawObject =~ m#/Type/XRef#) { 2922 if ($rawObject =~ m#/Root(\s+)(\d+)(\s+)(\d+)(\s+)R#) { 2923 $Root = "$2.$4"; 2924 $str = "/Root$1$2$3$4$5R"; 2925 $pos = index $rawObject, $str; 2926 substr($rawObject, $pos, length($str)) = ''; 2927 } 2928 if ($rawObject =~ m#/Info(\s+)(\d+)(\s+)(\d+)(\s+)R#) { 2929 $Info = "$2.$4"; 2930 $str = "/Info$1$2$3$4$5R"; 2931 $pos = index $rawObject, $str; 2932 substr($rawObject, $pos, length($str)) = ''; 2933 } 2934 } 2935 2936 # all other x y R -> @others 2937 @others = (); 2938 while (1) { 2939 if ($rawObject =~ m#(\d+)(\s+)(\d+)(\s+)R#) { 2940 $str = "$1$2$3$4R"; 2941 push @others, "$1.$3"; 2942 $pos = index $rawObject, $str; 2943 substr($rawObject, $pos, length($str)) = ''; 2944 } else { 2945 last; 2946 } 2947 } 2948 # go through all other refs and create element if necessary, 2949 # then increment its refcnt array element 2950 foreach (@others) { 2951 if (!defined $objList{$_}) { 2952 $objList{$_} = [0, 0, -1, -1, -1, []]; 2953 } 2954 $objList{$_}->[$idx_refcount]++; 2955 } 2956 foreach (@Kids) { 2957 if (!defined $objList{$_}) { 2958 $objList{$_} = [0, 0, -1, -1, -1, []]; 2959 } 2960 $objList{$_}->[$idx_refcount]++; 2961 } 2962 2963 } else { 2964 # not an object, but could be other stuff of interest 2965 # looking for trailer -> /Root x y R & /Info x y R 2966 if ($rawObject =~ m/trailer/) { 2967 if ($rawObject =~ m#trailer(.*)/Info(\s+)(\d+)(\s+)(\d+)(\s+)R#s) { 2968 $Info = "$3.$5"; 2969 } 2970 if ($rawObject =~ m#trailer(.*)/Root(\s+)(\d+)(\s+)(\d+)(\s+)R#s) { 2971 $Root = "$3.$5"; 2972 } 2973 } 2974 } 2975 } 2976 } 2977 2978 # increment Root and Info objects reference counts 2979 # they probably SHOULD already be defined (issue warning if not) 2980 if (!defined $Root) { 2981 print STDERR "$IC No Root object defined!\n" if $level >= $level_error; 2982 } else { 2983 if (!defined $objList{$Root}) { 2984 $objList{$Root} = [1, 0, -1, -1, -1, []]; 2985 print STDERR "$IC Root object $Root not found!\n" if $level >= $level_error; 2986 } 2987 $objList{$Root}->[$idx_refcount]++; 2988 } 2989 2990 # Info is optional 2991 if (!defined $Info) { 2992 print STDERR "$IC No Info object defined!\n" if $level >= $level_note; 2993 } else { 2994 if (!defined $objList{$Info}) { 2995 $objList{$Info} = [1, 0, -1, -1, -1, []]; 2996 print STDERR "$IC Info object $Info not found!\n" if $level >= $level_note; 2997 # possibly in a deleted object (on free list) 2998 } 2999 $objList{$Info}->[$idx_refcount]++; 3000 } 3001 3002 # revisit each element in objList 3003 # visit each Kid, their $idx_par_clmd should be -1 (set to this object) 3004 # (if not -1, is on multiple Kids lists) 3005 # their $idx_parent should be this object 3006 # they should have a Parent declared 3007 # any element with ref count of 0 and no Parent give warning unreachable 3008 # TBD: anything else to add to things to check? 3009 foreach my $thisObj (sort keys %objList) { 3010 3011 # was an object actually defined for this entry? 3012 # missing Info and Root messages already given, so flag is 1 ("defined") 3013 if ($objList{$thisObj}->[$idx_defined] == 0) { 3014 print STDERR "$IC object $thisObj referenced, but no entry found.\n" if $level >= $level_note; 3015 # it's apparently OK if the missing object is on the free list -- 3016 # it will just be ignored 3017 } 3018 3019 # check any Kids 3020 if ($objList{$thisObj}[$idx_kid_cnt] > 0) { 3021 # this object has children (/Kids), so explore them one level deep 3022 for (my $kidObj=0; $kidObj<$objList{$thisObj}[$idx_kid_cnt]; $kidObj++) { 3023 my $child = $objList{$thisObj}[$idx_kid_list]->[$kidObj]; 3024 # child's claimed parent should be -1, set to thisObj 3025 if ($objList{$child}[$idx_par_clmd] == -1) { 3026 # no one has claimed to be parent, so set to thisObj 3027 $objList{$child}[$idx_par_clmd] = $thisObj; 3028 } else { 3029 # someone else has already claimed to be parent 3030 print STDERR "$IC object $thisObj wants to claim object $child as its child, but $objList{$child}[$idx_par_clmd] already has!\nPossibly $child is on more than one /Kids list?\n" if $level >= $level_error; 3031 } 3032 # if no object defined for child, already flagged as missing 3033 if ($objList{$child}[$idx_defined] == 1) { 3034 # child should list thisObj as its Parent 3035 if ($objList{$child}[$idx_parent] == -1) { 3036 print STDERR "$IC object $thisObj claims $child as a child (/Kids), but $child claims no Parent!\n" if $level >= $level_error; 3037 $objList{$child}[$idx_parent] = $thisObj; 3038 } elsif ($objList{$child}[$idx_parent] != $thisObj) { 3039 print STDERR "$IC object $thisObj claims $child as a child (/Kids), but $child claims $objList{$child}[$idx_parent] as its parent!\n" if $level >= $level_error; 3040 } 3041 } 3042 } 3043 } 3044 3045 if ($objList{$thisObj}[$idx_parent] == -1 && 3046 $objList{$thisObj}[$idx_refcount] == 0) { 3047 print STDERR "$IC Warning: object $thisObj appears to be unreachable.\n" if $level >= $level_note; 3048 } 3049 } 3050 3051 if ($level >= $level_dump) { 3052 # dump analysis data 3053 use Data::Dumper; 3054 my $d = Data::Dumper->new([\%objList]); 3055 print "========= dump of $IC analysis data ===========\n"; 3056 print $d->Dump(); 3057 } 3058 3059 # if have entire processed PDF in $self 3060 if ($level >= $level_dumpself) { 3061 # dump whole data 3062 use Data::Dumper; 3063 my $d = Data::Dumper->new([$self]); 3064 print "========= dump of $IC PDF (self) data ===========\n"; 3065 print $d->Dump(); 3066 } 3067 3068 return $Version; 3069} 3070 30711; 3072 3073__END__ 3074 3075=back 3076 3077=cut 3078