File Coverage

blib/lib/PDF/API3/Compat/API2.pm
Criterion Covered Total %
statement 134 853 15.7
branch 0 280 0.0
condition 0 97 0.0
subroutine 44 107 41.1
pod 55 62 88.7
total 233 1399 16.6


line stmt bran cond sub pod time code
1             #=======================================================================
2             # ____ ____ _____ _ ____ ___ ____
3             # | _ \| _ \| ___| _ _ / \ | _ \_ _| |___ \
4             # | |_) | | | | |_ (_) (_) / _ \ | |_) | | __) |
5             # | __/| |_| | _| _ _ / ___ \| __/| | / __/
6             # |_| |____/|_| (_) (_) /_/ \_\_| |___| |_____|
7             #
8             # A Perl Module Chain to faciliate the Creation and Modification
9             # of High-Quality "Portable Document Format (PDF)" Files.
10             #
11             # Copyright 1999-2005 Alfred Reibenschuh .
12             #
13             #=======================================================================
14             #
15             # This library is free software; you can redistribute it and/or
16             # modify it under the terms of the GNU Lesser General Public
17             # License as published by the Free Software Foundation; either
18             # version 2 of the License, or (at your option) any later version.
19             #
20             # This library is distributed in the hope that it will be useful,
21             # but WITHOUT ANY WARRANTY; without even the implied warranty of
22             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23             # Lesser General Public License for more details.
24             #
25             # You should have received a copy of the GNU Lesser General Public
26             # License along with this library; if not, write to the
27             # Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28             # Boston, MA 02111-1307, USA.
29             #
30             # $Id: API2.pm,v 2.15 2008/01/18 00:11:38 areibens Exp $
31             #
32             #=======================================================================
33            
34             package PDF::API3::Compat::API2;
35            
36             BEGIN {
37            
38 1     1   6656 use vars qw( $VERSION $seq @FontDirs );
  1         3  
  1         112  
39            
40 1     1   523 ($VERSION) = "0.74";
41            
42 1         4 @FontDirs = ( (map { "$_/PDF/API3/Compat/API2/fonts" } @INC),
  12         30  
43             qw[ /usr/share/fonts /usr/local/share/fonts c:/windows/fonts c:/winnt/fonts ] );
44            
45 1         4 $seq="AA";
46            
47 1         63 require 5.008; # we need this for unicode support
48            
49 1     1   1056 use PDF::API3::Compat::API2::Basic::PDF::File;
  1         4  
  1         46  
50 1     1   13 use PDF::API3::Compat::API2::Basic::PDF::Page;
  1         2  
  1         18  
51 1     1   6 use PDF::API3::Compat::API2::Basic::PDF::Utils;
  1         2  
  1         153  
52            
53 1     1   864 use PDF::API3::Compat::API2::Util;
  1         4  
  1         261  
54 1     1   826 use PDF::API3::Compat::API2::Page;
  1         5  
  1         49  
55            
56 1     1   827 use PDF::API3::Compat::API2::Outlines;
  1         4  
  1         37  
57 1     1   716 use PDF::API3::Compat::API2::NamedDestination;
  1         4  
  1         55  
58            
59 1     1   792 use PDF::API3::Compat::API2::Resource::ExtGState;
  1         4  
  1         39  
60 1     1   817 use PDF::API3::Compat::API2::Resource::Pattern;
  1         4  
  1         37  
61 1     1   729 use PDF::API3::Compat::API2::Resource::Shading;
  1         3  
  1         34  
62            
63 1     1   791 use PDF::API3::Compat::API2::Resource::Font::CoreFont;
  1         4  
  1         45  
64 1     1   1080 use PDF::API3::Compat::API2::Resource::Font::Postscript;
  1         4  
  1         53  
65 1     1   820 use PDF::API3::Compat::API2::Resource::Font::BdFont;
  1         6  
  1         55  
66 1     1   813 use PDF::API3::Compat::API2::Resource::Font::SynFont;
  1         3  
  1         40  
67 1     1   865 use PDF::API3::Compat::API2::Resource::Font::neTrueType;
  1         4  
  1         73  
68 1     1   897 use PDF::API3::Compat::API2::Resource::CIDFont::TrueType;
  1         4  
  1         50  
69 1     1   852 use PDF::API3::Compat::API2::Resource::CIDFont::CJKFont;
  1         5  
  1         66  
70 1     1   804 use PDF::API3::Compat::API2::Resource::UniFont;
  1         4  
  1         38  
71            
72 1     1   765 use PDF::API3::Compat::API2::Resource::XObject::Image::JPEG;
  1         4  
  1         50  
73 1     1   917 use PDF::API3::Compat::API2::Resource::XObject::Image::TIFF;
  1         4  
  1         68  
74 1     1   1002 use PDF::API3::Compat::API2::Resource::XObject::Image::PNM;
  1         5  
  1         49  
75 1     1   974 use PDF::API3::Compat::API2::Resource::XObject::Image::PNG;
  1         5  
  1         56  
76 1     1   822 use PDF::API3::Compat::API2::Resource::XObject::Image::GIF;
  1         3  
  1         51  
77 1     1   907 use PDF::API3::Compat::API2::Resource::XObject::Image::GD;
  1         6  
  1         55  
78            
79 1     1   944 use PDF::API3::Compat::API2::Resource::XObject::Form::Hybrid;
  1         4  
  1         61  
80            
81 1     1   1068 use PDF::API3::Compat::API2::Resource::XObject::Form::BarCode::int2of5;
  1         4  
  1         67  
82 1     1   979 use PDF::API3::Compat::API2::Resource::XObject::Form::BarCode::codabar;
  1         5  
  1         63  
83 1     1   1089 use PDF::API3::Compat::API2::Resource::XObject::Form::BarCode::code128;
  1         4  
  1         71  
84 1     1   996 use PDF::API3::Compat::API2::Resource::XObject::Form::BarCode::code3of9;
  1         5  
  1         83  
85 1     1   1046 use PDF::API3::Compat::API2::Resource::XObject::Form::BarCode::ean13;
  1         6  
  1         70  
86            
87 1     1   990 use PDF::API3::Compat::API2::Resource::ColorSpace::Indexed::ACTFile;
  1         4  
  1         41  
88 1     1   950 use PDF::API3::Compat::API2::Resource::ColorSpace::Indexed::Hue;
  1         3  
  1         51  
89 1     1   951 use PDF::API3::Compat::API2::Resource::ColorSpace::Indexed::WebColor;
  1         4  
  1         56  
90            
91 1     1   920 use PDF::API3::Compat::API2::Resource::ColorSpace::Separation;
  1         5  
  1         64  
92 1     1   970 use PDF::API3::Compat::API2::Resource::ColorSpace::DeviceN;
  1         5  
  1         46  
93            
94 1     1   9 use Compress::Zlib;
  1         3  
  1         434  
95            
96 1     1   6 use Math::Trig;
  1         4  
  1         228  
97            
98 1     1   9 use POSIX qw( ceil floor );
  1         2  
  1         10  
99            
100 1     1   86 use utf8;
  1         3  
  1         11  
101 1     1   29 use Encode qw(:all);
  1         4  
  1         356  
102            
103 1     1   1235 use FileHandle;
  1         1294  
  1         7  
104             }
105            
106 1     1   5 no warnings qw[ deprecated recursion uninitialized ];
  1         2  
  1         12006  
107            
108             =head1 NAME
109            
110             PDF::API3::Compat::API2 - A Perl Module Chain to faciliate the Creation and Modification of High-Quality "Portable Document Format (aka. PDF)" Files.
111            
112             =head1 SYNOPSIS
113            
114             use PDF::API3::Compat::API2;
115             #
116             $pdf = PDF::API3::Compat::API2->new;
117             $pdf = PDF::API3::Compat::API2->open('some.pdf');
118             $page = $pdf->page;
119             $page = $pdf->openpage($pagenum);
120             $img = $pdf->image('some.jpg');
121             $font = $pdf->corefont('Times-Roman');
122             $font = $pdf->ttfont('TimesNewRoman.ttf');
123            
124             =head1 GENERIC METHODS
125            
126             =over 4
127            
128             =item $pdf = PDF::API->new %opts
129            
130             Creates a new pdf-file object. If you know beforehand
131             to save the pdf to file you can give the '-file' option,
132             to minimize possible memory requirements later-on.
133            
134             B
135            
136             $pdf = PDF::API3::Compat::API2->new();
137             ...
138             print $pdf->stringify;
139            
140             $pdf = PDF::API3::Compat::API2->new();
141             ...
142             $pdf->saveas("our/new.pdf");
143            
144             $pdf = PDF::API3::Compat::API2->new(-file => 'our/new.pdf');
145             ...
146             $pdf->save;
147            
148             =cut
149            
150             sub new {
151 0     0 1   my $class=shift(@_);
152 0           my %opt=@_;
153 0           my $self={};
154 0           bless($self,$class);
155 0           $self->{pdf}=PDF::API3::Compat::API2::Basic::PDF::File->new();
156 0           $self->{time}='_'.pdfkey(time());
157            
158 0           $self->{pdf}->{' version'} = 4;
159 0           $self->{pages} = PDF::API3::Compat::API2::Basic::PDF::Pages->new($self->{pdf});
160 0           $self->{pages}->proc_set(qw( PDF Text ImageB ImageC ImageI ));
161 0   0       $self->{pages}->{Resources}||=PDFDict();
162 0 0         $self->{pdf}->new_obj($self->{pages}->{Resources}) unless($self->{pages}->{Resources}->is_obj($self->{pdf}));
163 0           $self->{catalog}=$self->{pdf}->{Root};
164 0           $self->{fonts}={};
165 0           $self->{pagestack}=[];
166 0 0         $self->{forcecompress}= ($^O eq 'os390') ? 0 : 1;
167 0           $self->preferences(%opt);
168 0 0         if($opt{-file}) {
169 0           $self->{' filed'}=$opt{-file};
170 0           $self->{pdf}->create_file($opt{-file});
171             }
172 0           $self->{infoMeta}=[qw( Author CreationDate ModDate Creator Producer Title Subject Keywords )];
173 0           $self->info( 'Producer' => $PDF::API3::Compat::API2::Version::CVersion{vFredo}." [$^O]" );
174 0           return $self;
175             }
176            
177             =item $pdf = PDF::API->open $pdffile
178            
179             Opens an existing PDF for modification.
180            
181             B
182            
183             $pdf = PDF::API3::Compat::API2->open('my/old.pdf');
184             ...
185             $pdf->saveas("our/new.pdf");
186            
187             $pdf = PDF::API3::Compat::API2->open('our/to/be/updated.pdf');
188             ...
189             $pdf->update;
190            
191             =cut
192            
193             sub open {
194 0     0 1   my $class=shift(@_);
195 0           my $file=shift(@_);
196 0           my %opt=@_;
197 0           my $filestr;
198 0           my $self={};
199 0           bless($self,$class);
200 0           $self->default('Compression',1);
201 0           $self->default('subset',1);
202 0           $self->default('update',1);
203 0           foreach my $para (keys(%opt)) {
204 0           $self->default($para,$opt{$para});
205             }
206 0 0         die "File '$file' does not exist." unless(-f $file);
207            
208 0           $self->{content_ref} = \$filestr;
209 0           my $fh = new FileHandle;
210 0 0         CORE::open($fh, "+<", \$filestr) || die "Can't begin scalar IO";
211 0           binmode($fh,':raw');
212            
213 0           my $inf = new FileHandle;
214 0           CORE::open($inf,$file);
215 0           binmode($inf,':raw');
216 0           $inf->seek(0,0);
217 0           while(!$inf->eof) {
218 0           $inf->read($in,512);
219 0           $fh->print($in);
220             }
221 0           $inf->close;
222 0           $fh->seek(0,0);
223            
224 0           $self->{pdf}=PDF::API3::Compat::API2::Basic::PDF::File->open($fh,1);
225 0           $self->{pdf}->{' fname'}=$file;
226 0           $self->{pdf}->{'Root'}->realise;
227 0           $self->{pages}=$self->{pdf}->{'Root'}->{'Pages'}->realise;
228 0           $self->{pdf}->{' version'} = 3;
229 0           $self->{pdf}->{' apipagecount'} = 0;
230 0           my @pages=proc_pages($self->{pdf},$self->{pages});
231 0           $self->{pagestack}=[sort {$a->{' pnum'} <=> $b->{' pnum'}} @pages];
  0            
232 0           $self->{catalog}=$self->{pdf}->{Root};
233 0           $self->{reopened}=1;
234 0           $self->{time}='_'.pdfkey(time());
235 0 0         $self->{forcecompress}= ($^O eq 'os390') ? 0 : 1;
236 0           $self->{fonts}={};
237 0           $self->{infoMeta}=[qw( Author CreationDate ModDate Creator Producer Title Subject Keywords )];
238 0           return $self;
239             }
240            
241             =item $pdf = PDF::API->openScalar $pdfstream
242            
243             Opens an existing PDF-stream for modification.
244            
245             B
246            
247             open($fh,'our/stream.pdf') or die "$@";
248             @pdf = <$fh>;
249             $pdf = PDF::API->openScalar(join('',@pdf));
250             ...
251             $pdf->saveas('our/new.pdf');
252            
253             =cut
254            
255             sub openScalar {
256 0     0 1   my $class=shift(@_);
257 0           my $file=shift(@_);
258 0           my %opt=@_;
259 0           my $self={};
260 0           bless($self,$class);
261 0           $self->default('Compression',1);
262 0           $self->default('subset',1);
263 0           $self->default('update',1);
264 0           foreach my $para (keys(%opt)) {
265 0           $self->default($para,$opt{$para});
266             }
267 0           $self->{content_ref} = \$file;
268 0           my $fh;
269 0 0         CORE::open($fh, "+<", \$file) || die "Can't begin scalar IO";
270 0           $self->{pdf}=PDF::API3::Compat::API2::Basic::PDF::File->open($fh,1);
271 0           $self->{pdf}->{'Root'}->realise;
272 0           $self->{pages}=$self->{pdf}->{'Root'}->{'Pages'}->realise;
273 0           $self->{pdf}->{' version'} = 3;
274 0           $self->{pdf}->{' apipagecount'} = 0;
275 0           my @pages=proc_pages($self->{pdf},$self->{pages});
276 0           $self->{pagestack}=[sort {$a->{' pnum'} <=> $b->{' pnum'}} @pages];
  0            
277 0           $self->{catalog}=$self->{pdf}->{Root};
278 0           $self->{reopened}=1;
279 0           $self->{time}='_'.pdfkey(time());
280 0 0         $self->{forcecompress}= ($^O eq 'os390') ? 0 : 1;
281 0           $self->{fonts}={};
282 0           $self->{infoMeta}=[qw( Author CreationDate ModDate Creator Producer Title Subject Keywords )];
283 0           return $self;
284             }
285            
286             =item $pdf->preferences %opts
287            
288             Controls viewing-preferences for the pdf.
289            
290             =cut
291            
292             =pod
293            
294             B
295            
296             I<-fullscreen>
297             ... Full-screen mode, with no menu bar, window controls, or any other window visible.
298            
299             I<-thumbs>
300             ... Thumbnail images visible.
301            
302             I<-outlines>
303             ... Document outline visible.
304            
305             =cut
306            
307             =pod
308            
309             B
310            
311             I<-singlepage>
312             ... Display one page at a time.
313            
314             I<-onecolumn>
315             ... Display the pages in one column.
316            
317             I<-twocolumnleft>
318             ... Display the pages in two columns, with oddnumbered pages on the left.
319            
320             I<-twocolumnright>
321             ... Display the pages in two columns, with oddnumbered pages on the right.
322            
323             =cut
324            
325             =pod
326            
327             B
328            
329             I<-hidetoolbar>
330             ... Specifying whether to hide tool bars.
331            
332             I<-hidemenubar>
333             ... Specifying whether to hide menu bars.
334            
335             I<-hidewindowui>
336             ... Specifying whether to hide user interface elements.
337            
338             I<-fitwindow>
339             ... Specifying whether to resize the document’s window to the size of the displayed page.
340            
341             I<-centerwindow>
342             ... Specifying whether to position the document’s window in the center of the screen.
343            
344             I<-displaytitle>
345             ... Specifying whether the window’s title bar should display the document title
346             taken from the Title entry of the document information dictionary.
347            
348             I<-afterfullscreenthumbs>
349             ... Thumbnail images visible after Full-screen mode.
350            
351             I<-afterfullscreenoutlines>
352             ... Document outline visible after Full-screen mode.
353            
354             I<-printscalingnone>
355             ... Set the default print setting for page scaling to none.
356            
357             =cut
358            
359             =pod
360            
361             B
362            
363             I<-firstpage> => [ $pageobj, %opts]
364             ... Specifying the page to be displayed, plus one of the following options:
365            
366             =cut
367            
368             =pod
369            
370             B
371            
372             I<-fit> => 1
373             ... Display the page designated by page, with its contents magnified just enough to
374             fit the entire page within the window both horizontally and vertically. If the
375             required horizontal and vertical magnification factors are different, use the
376             smaller of the two, centering the page within the window in the other dimension.
377            
378             I<-fith> => $top
379             ... Display the page designated by page, with the vertical coordinate top positioned
380             at the top edge of the window and the contents of the page magnified just enough
381             to fit the entire width of the page within the window.
382            
383             I<-fitv> => $left
384             ... Display the page designated by page, with the horizontal coordinate left positioned
385             at the left edge of the window and the contents of the page magnified just enough
386             to fit the entire height of the page within the window.
387            
388             I<-fitr> => [ $left, $bottom, $right, $top ]
389             ... Display the page designated by page, with its contents magnified just enough to
390             fit the rectangle specified by the coordinates left, bottom, right, and top
391             entirely within the window both horizontally and vertically. If the required
392             horizontal and vertical magnification factors are different, use the smaller of
393             the two, centering the rectangle within the window in the other dimension.
394            
395             I<-fitb> => 1
396             ... Display the page designated by page, with its contents magnified just enough
397             to fit its bounding box entirely within the window both horizontally and
398             vertically. If the required horizontal and vertical magnification factors are
399             different, use the smaller of the two, centering the bounding box within the
400             window in the other dimension.
401            
402             I<-fitbh> => $top
403             ... Display the page designated by page, with the vertical coordinate top
404             positioned at the top edge of the window and the contents of the page
405             magnified just enough to fit the entire width of its bounding box
406             within the window.
407            
408             I<-fitbv> => $left
409             ... Display the page designated by page, with the horizontal coordinate
410             left positioned at the left edge of the window and the contents of the page
411             magnified just enough to fit the entire height of its bounding box within the
412             window.
413            
414             I<-xyz> => [ $left, $top, $zoom ]
415             ... Display the page designated by page, with the coordinates (left, top) positioned
416             at the top-left corner of the window and the contents of the page magnified by
417             the factor zoom. A zero (0) value for any of the parameters left, top, or zoom
418             specifies that the current value of that parameter is to be retained unchanged.
419            
420             =cut
421            
422             =pod
423            
424             B
425            
426             $pdf->preferences(
427             -fullscreen => 1,
428             -onecolumn => 1,
429             -afterfullscreenoutlines => 1,
430             -firstpage => [ $pageobj , -fit => 1],
431             );
432            
433             =cut
434            
435             sub preferences {
436 0     0 1   my $self=shift @_;
437 0           my %opt=@_;
438 0 0         if($opt{-fullscreen}) {
    0          
    0          
439 0           $self->{catalog}->{PageMode}=PDFName('FullScreen');
440             } elsif($opt{-thumbs}) {
441 0           $self->{catalog}->{PageMode}=PDFName('UseThumbs');
442             } elsif($opt{-outlines}) {
443 0           $self->{catalog}->{PageMode}=PDFName('UseOutlines');
444             } else {
445 0           $self->{catalog}->{PageMode}=PDFName('UseNone');
446             }
447 0 0         if($opt{-singlepage}) {
    0          
    0          
    0          
448 0           $self->{catalog}->{PageLayout}=PDFName('SinglePage');
449             } elsif($opt{-onecolumn}) {
450 0           $self->{catalog}->{PageLayout}=PDFName('OneColumn');
451             } elsif($opt{-twocolumnleft}) {
452 0           $self->{catalog}->{PageLayout}=PDFName('TwoColumnLeft');
453             } elsif($opt{-twocolumnright}) {
454 0           $self->{catalog}->{PageLayout}=PDFName('TwoColumnRight');
455             } else {
456 0           $self->{catalog}->{PageLayout}=PDFName('SinglePage');
457             }
458            
459 0   0       $self->{catalog}->{ViewerPreferences}||=PDFDict();
460 0           $self->{catalog}->{ViewerPreferences}->realise;
461            
462 0 0         if($opt{-hidetoolbar}) {
463 0           $self->{catalog}->{ViewerPreferences}->{HideToolbar}=PDFBool(1);
464             }
465 0 0         if($opt{-hidemenubar}) {
466 0           $self->{catalog}->{ViewerPreferences}->{HideMenubar}=PDFBool(1);
467             }
468 0 0         if($opt{-hidewindowui}) {
469 0           $self->{catalog}->{ViewerPreferences}->{HideWindowUI}=PDFBool(1);
470             }
471 0 0         if($opt{-fitwindow}) {
472 0           $self->{catalog}->{ViewerPreferences}->{FitWindow}=PDFBool(1);
473             }
474 0 0         if($opt{-centerwindow}) {
475 0           $self->{catalog}->{ViewerPreferences}->{CenterWindow}=PDFBool(1);
476             }
477 0 0         if($opt{-displaytitle}) {
478 0           $self->{catalog}->{ViewerPreferences}->{DisplayDocTitle}=PDFBool(1);
479             }
480 0 0         if($opt{-righttoleft}) {
481 0           $self->{catalog}->{ViewerPreferences}->{Direction}=PDFName("R2L");
482             }
483            
484 0 0         if($opt{-afterfullscreenthumbs}) {
    0          
485 0           $self->{catalog}->{ViewerPreferences}->{NonFullScreenPageMode}=PDFName('UseThumbs');
486             } elsif($opt{-afterfullscreenoutlines}) {
487 0           $self->{catalog}->{ViewerPreferences}->{NonFullScreenPageMode}=PDFName('UseOutlines');
488             } else {
489 0           $self->{catalog}->{ViewerPreferences}->{NonFullScreenPageMode}=PDFName('UseNone');
490             }
491            
492 0 0         if($opt{-printscalingnone}) {
493 0           $self->{catalog}->{ViewerPreferences}->{PrintScaling}=PDFName("None");
494             }
495            
496 0 0         if($opt{-firstpage}) {
497 0           my ($page,%o)=@{$opt{-firstpage}};
  0            
498            
499 0 0         $o{-fit}=1 if(scalar(keys %o)<1);
500            
501 0 0         if(defined $o{-fit}) {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
502 0           $self->{catalog}->{OpenAction}=PDFArray($page,PDFName('Fit'));
503             } elsif(defined $o{-fith}) {
504 0           $self->{catalog}->{OpenAction}=PDFArray($page,PDFName('FitH'),PDFNum($o{-fith}));
505             } elsif(defined $o{-fitb}) {
506 0           $self->{catalog}->{OpenAction}=PDFArray($page,PDFName('FitB'));
507             } elsif(defined $o{-fitbh}) {
508 0           $self->{catalog}->{OpenAction}=PDFArray($page,PDFName('FitBH'),PDFNum($o{-fitbh}));
509             } elsif(defined $o{-fitv}) {
510 0           $self->{catalog}->{OpenAction}=PDFArray($page,PDFName('FitV'),PDFNum($o{-fitv}));
511             } elsif(defined $o{-fitbv}) {
512 0           $self->{catalog}->{OpenAction}=PDFArray($page,PDFName('FitBV'),PDFNum($o{-fitbv}));
513             } elsif(defined $o{-fitr}) {
514 0 0         die "insufficient parameters to -fitr => [] " unless(scalar @{$o{-fitr}} == 4);
  0            
515 0           $self->{catalog}->{OpenAction}=PDFArray($page,PDFName('FitR'),map {PDFNum($_)} @{$o{-fitr}});
  0            
  0            
516             } elsif(defined $o{-xyz}) {
517 0 0         die "insufficient parameters to -xyz => [] " unless(scalar @{$o{-xyz}} == 3);
  0            
518 0           $self->{catalog}->{OpenAction}=PDFArray($page,PDFName('XYZ'),map {PDFNum($_)} @{$o{-xyz}});
  0            
  0            
519             }
520             }
521 0           $self->{pdf}->out_obj($self->{catalog});
522            
523 0           return $self;
524             }
525            
526             =item $val = $pdf->default $parameter
527            
528             =item $pdf->default $parameter, $val
529            
530             Gets/Sets default values for the behaviour of ::API2.
531            
532             B
533            
534             I ... prohibits API2 from rotating imported/opened page to re-create a default pdf-context.
535            
536             I ... enables than API2 will add save/restore commands upon imported/opened pages to preserve graphics-state for modification.
537            
538             I ... enables importing of annotations (B<*EXPERIMENTAL*>).
539            
540             =cut
541            
542             sub default {
543 0     0 1   my ($self,$parameter,$var)=@_;
544 0           $parameter=~s/[^a-zA-Z\d]//g;
545 0           $parameter=lc($parameter);
546 0           my $temp=$self->{$parameter};
547 0 0         if(defined $var) {
548 0           $self->{$parameter}=$var;
549             }
550 0           return($temp);
551             }
552            
553             =item $bool = $pdf->isEncrypted
554            
555             Checks if the previously opened pdf is encrypted.
556            
557             =cut
558            
559             sub isEncrypted {
560 0     0 1   my $self=shift @_;
561 0 0         return(defined($self->{pdf}->{'Encrypt'}) ? 1 : 0);
562             }
563            
564             =item %infohash = $pdf->info %infohash
565            
566             Sets/Gets the info structure of the document.
567            
568             B
569            
570             %h = $pdf->info(
571             'Author' => " Alfred Reibenschuh ",
572             'CreationDate' => "D:20020911000000+01'00'",
573             'ModDate' => "D:YYYYMMDDhhmmssOHH'mm'",
574             'Creator' => "fredos-script.pl",
575             'Producer' => "PDF::API3::Compat::API2",
576             'Title' => "some Publication",
577             'Subject' => "perl ?",
578             'Keywords' => "all good things are pdf"
579             );
580             print "Author: $h{Author}\n";
581            
582            
583             =cut
584            
585             sub info {
586 0     0 1   my $self=shift @_;
587 0           my %opt=@_;
588            
589 0 0         if(!defined($self->{pdf}->{'Info'})) {
590 0           $self->{pdf}->{'Info'}=PDFDict();
591 0           $self->{pdf}->new_obj($self->{'pdf'}->{'Info'});
592             } else {
593 0           $self->{pdf}->{'Info'}->realise;
594             }
595            
596 0 0         if(scalar @_) {
597 0           foreach my $k (@{$self->{infoMeta}}) {
  0            
598 0 0         next unless(defined $opt{$k});
599 0 0         if(is_utf8($opt{$k})) {
600 0   0       $self->{pdf}->{'Info'}->{$k}=PDFUtf($opt{$k}||'NONE');
601             #} elsif(is_utf8($opt{$k}) || utf8::valid($opt{$k})) {
602             # $self->{pdf}->{'Info'}->{$k}=PDFUtf($opt{$k}||'NONE');
603             } else {
604 0   0       $self->{pdf}->{'Info'}->{$k}=PDFStr($opt{$k}||'NONE');
605             }
606             }
607 0           $self->{pdf}->out_obj($self->{pdf}->{'Info'});
608             }
609            
610            
611 0 0         if(defined $self->{pdf}->{'Info'}) {
612 0           %opt=();
613 0           foreach my $k (@{$self->{infoMeta}}) {
  0            
614 0 0         next unless(defined $self->{pdf}->{'Info'}->{$k});
615 0           $opt{$k}=$self->{pdf}->{'Info'}->{$k}->val;
616 0 0 0       if ((unpack('n',$opt{$k})==0xfffe) or (unpack('n',$opt{$k})==0xfeff))
617             {
618 0           $opt{$k} = decode('UTF-16', $self->{pdf}->{'Info'}->{$k}->val);
619             }
620             }
621             }
622 0           return(%opt);
623             }
624            
625             =item @meta_data_attribs = $pdf->infoMetaAttributes @meta_data_attribs
626            
627             Sets/Gets the supported info-structure tags.
628            
629             B
630            
631             @attrs = $pdf->infoMetaAttributes;
632             print "Supported Attributes: @attr\n";
633             @attrs = $pdf->infoMetaAttributes('CustomField1');
634             print "Supported Attributes: @attr\n";
635            
636             =cut
637            
638             sub infoMetaAttributes
639             {
640 0     0 1   my ($self,@attr) = @_;
641 0 0         if(scalar @attr > 0) {
642 0           my %at = map { $_ => $_ } (@{$self->{infoMeta}},@attr);
  0            
  0            
643 0           @{$self->{infoMeta}}=(keys %at);
  0            
644             }
645 0           return(@{$self->{infoMeta}});
  0            
646             }
647            
648             =item $xml = $pdf->xmpMetadata $xml
649            
650             Sets/Gets the XMP XML data-stream.
651            
652             B
653            
654             $xml = $pdf->xmpMetadata;
655             print "PDFs Metadata reads: $xml\n";
656             $xml=<
657            
658            
659            
660            
661            
662            
663            
664             Adobe Portable Document Format (PDF)Adobe Systems IncorporatedPDF Reference, version 1.6
665            
666            
667            
668             EOT
669             $xml = $pdf->xmpMetadata($xml);
670             print "PDFs Metadata now reads: $xml\n";
671            
672             =cut
673            
674             sub xmpMetadata {
675 0     0 1   my $self=shift @_;
676            
677 0 0         if(!defined($self->{catalog}->{Metadata}))
678             {
679 0           $self->{catalog}->{Metadata}=PDFDict();
680 0           $self->{catalog}->{Metadata}->{Type}=PDFName('Metadata');
681 0           $self->{catalog}->{Metadata}->{Subtype}=PDFName('XML');
682 0           $self->{pdf}->new_obj($self->{catalog}->{Metadata});
683             }
684             else
685             {
686 0           $self->{catalog}->{Metadata}->realise;
687 0           $self->{catalog}->{Metadata}->{' stream'}=unfilter($self->{catalog}->{Metadata}->{Filter}, $self->{catalog}->{Metadata}->{' stream'});
688 0           delete $self->{catalog}->{Metadata}->{' nofilt'};
689 0           delete $self->{catalog}->{Metadata}->{Filter};
690             }
691            
692 0           my $md=$self->{catalog}->{Metadata};
693            
694 0 0         if(defined $_[0])
695             {
696 0           $md->{' stream'}=$_[0];
697 0           delete $md->{Filter};
698 0           delete $md->{' nofilt'};
699 0           $self->{pdf}->out_obj($md);
700 0           $self->{pdf}->out_obj($self->{catalog});
701             }
702 0           return($md->{' stream'});
703             }
704            
705             =item $pdf->pageLabel $index $options
706            
707             Sets PageLabel options.
708            
709             B
710            
711             I<-style> ... 'Roman', 'roman', 'decimal', 'Alpha' or 'alpha'.
712            
713             I<-start> ... restart numbering at given number.
714            
715             I<-prefix> ... text prefix for numbering.
716            
717             B
718            
719             $pdf->pageLabel( 0, {
720             -style => 'roman',
721             } ); # start with roman numbering
722            
723             $pdf->pageLabel( 4, {
724             -style => 'decimal',
725             } ); # switch to arabic
726            
727             $pdf->pageLabel( 32, {
728             -start => 1,
729             -prefix => 'A-'
730             } ); # numbering for appendix A
731            
732             $pdf->pageLabel( 36, {
733             -start => 1,
734             -prefix => 'B-'
735             } ); # numbering for appendix B
736            
737             $pdf->pageLabel( 40, {
738             -style => 'Roman'
739             -start => 1,
740             -prefix => 'Index '
741             } ); # numbering for index
742            
743             =cut
744            
745             sub pageLabel {
746 0     0 1   my $self=shift @_;
747            
748 0   0       $self->{catalog}->{PageLabels}||=PDFDict();
749 0   0       $self->{catalog}->{PageLabels}->{Nums}||=PDFArray();
750            
751 0           my $arr=$self->{catalog}->{PageLabels}->{Nums};
752 0           while(scalar @_)
753             {
754 0           my $index=shift @_;
755 0           my $opts=shift @_;
756            
757 0           $arr->add_elements(PDFNum($index));
758            
759 0           my $d=PDFDict();
760 0 0         if($opts->{-style} eq 'Roman')
    0          
    0          
    0          
761             {
762 0           $d->{S}=PDFName('R');
763             }
764             elsif($opts->{-style} eq 'roman')
765             {
766 0           $d->{S}=PDFName('r');
767             }
768             elsif($opts->{-style} eq 'Alpha')
769             {
770 0           $d->{S}=PDFName('A');
771             }
772             elsif($opts->{-style} eq 'alpha')
773             {
774 0           $d->{S}=PDFName('a');
775             }
776             else
777             {
778 0           $d->{S}=PDFName('D');
779             }
780            
781 0 0         if(defined $opts->{-prefix})
782             {
783 0           $d->{P}=PDFStr($opts->{-prefix});
784             }
785            
786 0 0         if(defined $opts->{-start})
787             {
788 0           $d->{St}=PDFNum($opts->{-start});
789             }
790            
791 0           $arr->add_elements($d);
792             }
793             }
794            
795             =item $pdf->finishobjects @objects
796            
797             Force objects to be written to file if available.
798            
799             B
800            
801             $pdf = PDF::API3::Compat::API2->new(-file => 'our/new.pdf');
802             ...
803             $pdf->finishobjects($page, $gfx, $txt);
804             ...
805             $pdf->save;
806            
807             =cut
808            
809             sub finishobjects {
810 0     0 1   my ($self,@objs)=@_;
811 0 0         if($self->{reopened}) {
    0          
812 0           die "invalid method invokation: no file, use 'saveas' instead.";
813             } elsif($self->{' filed'}) {
814 0           $self->{pdf}->ship_out(@objs);
815             } else {
816 0           die "invalid method invokation: no file, use 'saveas' instead.";
817             }
818             }
819            
820             sub proc_pages {
821 0     0 0   my ($pdf, $pgs) = @_;
822 0           my ($pg, $pgref, @pglist);
823            
824 0 0         if(defined($pgs->{Resources})) {
825 0           eval {
826 0           $pgs->{Resources}->realise;
827             };
828             }
829 0           foreach $pg ($pgs->{'Kids'}->elementsof) {
830 0           $pg->realise;
831 0 0         if ($pg->{'Type'}->val =~ m/^Pages$/o)
832             {
833 0           my @morepages = proc_pages($pdf, $pg);
834 0           push(@pglist, @morepages);
835             }
836             else
837             {
838 0           $pdf->{' apipagecount'}++;
839 0           $pg->{' pnum'} = $pdf->{' apipagecount'};
840 0 0         if(defined($pg->{Resources})) {
841 0           eval {
842 0           $pg->{Resources}->realise;
843             };
844             }
845 0           push (@pglist, $pg);
846             }
847             }
848 0           return(@pglist);
849             }
850            
851             =item $pdf->update
852            
853             Updates a previously "opened" document after all changes have been applied.
854            
855             B
856            
857             $pdf = PDF::API3::Compat::API2->open('our/to/be/updated.pdf');
858             ...
859             $pdf->update;
860            
861             =cut
862            
863             sub update {
864 0     0 1   my $self=shift @_;
865 0           $self->saveas($self->{pdf}->{' fname'});
866             }
867            
868             =item $pdf->saveas $file
869            
870             Saves the document to file.
871            
872             B
873            
874             $pdf = PDF::API3::Compat::API2->new();
875             ...
876             $pdf->saveas("our/new.pdf");
877            
878             =cut
879            
880             sub saveas {
881 0     0 1   my ($self,$file)=@_;
882 0 0         if($self->{reopened}) {
    0          
883 0           $self->{pdf}->append_file;
884 0           CORE::open(OUTF,">$file");
885 0           binmode(OUTF,':raw');
886 0           print OUTF ${$self->{content_ref}};
  0            
887 0           CORE::close(OUTF);
888             } elsif($self->{' filed'}) {
889 0           $self->{pdf}->close_file;
890             } else {
891 0           $self->{pdf}->out_file($file);
892             }
893 0           $self->end;
894             }
895            
896             sub save {
897 0     0 0   my ($self,$file)=@_;
898 0 0         if($self->{reopened}) {
    0          
899 0           die "invalid method invokation: use 'saveas' instead.";
900             } elsif($self->{' filed'}) {
901 0           $self->{pdf}->close_file;
902             } else {
903 0           die "invalid method invokation: use 'saveas' instead.";
904             }
905 0           $self->end;
906             }
907            
908             sub save_xml {
909 0     0 0   my ($self,$file)=@_;
910 0           my $fh=IO::File->new;
911 0           $fh->open("> $file");
912 0           $self->{pdf}->save_xml($fh);
913 0           $fh->close;
914 0           $self->end;
915             }
916            
917            
918             =item $string = $pdf->stringify
919            
920             Returns the document in a string.
921            
922             B
923            
924             $pdf = PDF::API3::Compat::API2->new();
925             ...
926             print $pdf->stringify;
927            
928             =cut
929            
930             sub stringify {
931 0     0 1   my ($self)=@_;
932 0           my $str;
933 0 0 0       if((defined $self->{reopened}) && ($self->{reopened}==1)) {
934 0           $self->{pdf}->append_file;
935 0           $str=${$self->{content_ref}};
  0            
936             } else {
937 0           my $fh = new FileHandle;
938 0 0         CORE::open($fh, ">", \$str) || die "Can't begin scalar IO";
939 0           $self->{pdf}->out_file($fh);
940 0           $fh->close;
941             }
942 0           $self->end;
943 0           return($str);
944             }
945            
946 0     0 0   sub release { $_[0]->end; return(undef);}
  0            
947            
948             =item $pdf->end
949            
950             Destroys the document.
951            
952             =cut
953            
954             sub end {
955 0     0 1   my $self=shift(@_);
956 0 0         $self->{pdf}->release if(defined($self->{pdf}));
957            
958 0           foreach my $key (keys %{$self})
  0            
959             {
960 0           $self->{$key}=undef;
961 0           delete ($self->{$key});
962             }
963            
964 0           undef;
965             }
966            
967             =back
968            
969             =head1 PAGE METHODS
970            
971             =over 4
972            
973             =item $page = $pdf->page
974            
975             =item $page = $pdf->page $index
976            
977             Returns a new page object or inserts-and-returns a new page at $index.
978            
979             B on $index
980            
981             -1 ... is inserted before the last page
982             1 ... is inserted before page number 1 (the first page)
983             0 ... is simply appended
984            
985             =cut
986            
987             sub page {
988 0     0 1   my $self=shift;
989 0   0       my $index=shift || 0;
990 0           my $page;
991 0 0         if($index==0) {
992 0           $page=PDF::API3::Compat::API2::Page->new($self->{pdf},$self->{pages});
993             } else {
994 0           $page=PDF::API3::Compat::API2::Page->new($self->{pdf},$self->{pages},$index-1);
995             }
996 0           $page->{' apipdf'}=$self->{pdf};
997 0           $page->{' api'}=$self;
998 0           $self->{pdf}->out_obj($page);
999 0           $self->{pdf}->out_obj($self->{pages});
1000 0 0         if($index==0) {
    0          
1001 0           push(@{$self->{pagestack}},$page);
  0            
1002             } elsif($index<0) {
1003 0           splice(@{$self->{pagestack}},$index,0,$page);
  0            
1004             } else {
1005 0           splice(@{$self->{pagestack}},$index-1,0,$page);
  0            
1006             }
1007             # $page->{Resources}=$self->{pages}->{Resources};
1008 0           return $page;
1009             }
1010            
1011             =item $pageobj = $pdf->openpage $index
1012            
1013             Returns the pageobject of page $index.
1014            
1015             B on $index
1016            
1017             -1,0 ... returns the last page
1018             1 ... returns page number 1
1019            
1020             B (A Document with 99 Pages)
1021            
1022             $page = $pdf->openpage(1); # returns the first page
1023             $page = $pdf->openpage(99); # returns the last page
1024             $page = $pdf->openpage(-1); # returns the last page
1025             $page = $pdf->openpage(999); # returns undef
1026            
1027             =cut
1028            
1029             sub openpage {
1030 0     0 1   my $self=shift @_;
1031 0   0       my $index=shift @_||0;
1032 0           my ($page,$rotate,$media,$trans);
1033            
1034 0 0         if($index==0)
    0          
1035             {
1036 0           $page=$self->{pagestack}->[-1];
1037             }
1038             elsif($index<0)
1039             {
1040 0           $page=$self->{pagestack}->[$index];
1041             }
1042             else
1043             {
1044 0           $page=$self->{pagestack}->[$index-1];
1045             }
1046 0 0         return undef unless(ref $page);
1047            
1048 0 0         if(ref($page) ne 'PDF::API3::Compat::API2::Page')
1049             {
1050 0           bless($page,'PDF::API3::Compat::API2::Page');
1051 0           $page->{' apipdf'}=$self->{pdf};
1052 0           $page->{' api'}=$self;
1053 0           $self->{pdf}->out_obj($page);
1054 0 0 0       if(($rotate=$page->find_prop('Rotate')) && (!defined($page->{' fixed'}) || $page->{' fixed'}<1))
      0        
1055             {
1056 0           $rotate=($rotate->val+360)%360;
1057            
1058 0 0 0       if($rotate!=0 && !$self->default('nounrotate')) {
1059 0           $page->{Rotate}=PDFNum(0);
1060 0           foreach my $mediatype (qw( MediaBox CropBox BleedBox TrimBox ArtBox )) {
1061 0 0         if($media=$page->find_prop($mediatype)) {
1062 0           $media=[ map{ $_->val } $media->elementsof ];
  0            
1063             } else {
1064 0           $media=[0,0,612,792];
1065 0 0         next if($mediatype ne 'MediaBox');
1066             }
1067 0 0         if($rotate==90) {
    0          
    0          
1068 0 0         $trans="0 -1 1 0 0 $media->[2] cm" if($mediatype eq 'MediaBox');
1069 0           $media=[$media->[1],$media->[0],$media->[3],$media->[2]];
1070             } elsif($rotate==180) {
1071 0 0         $trans="-1 0 0 -1 $media->[2] $media->[3] cm" if($mediatype eq 'MediaBox');
1072             } elsif($rotate==270) {
1073 0 0         $trans="0 1 -1 0 $media->[3] 0 cm" if($mediatype eq 'MediaBox');
1074 0           $media=[$media->[1],$media->[0],$media->[3],$media->[2]];
1075             }
1076 0           $page->{$mediatype}=PDFArray(map { PDFNum($_) } @{$media});
  0            
  0            
1077             }
1078             } else {
1079 0           $trans="";
1080             }
1081             } else {
1082 0           $trans="";
1083             }
1084            
1085 0 0 0       if(defined $page->{Contents} && (!defined($page->{' fixed'}) || $page->{' fixed'}<1) ) {
      0        
1086 0           $page->fixcontents;
1087 0           my $uncontent=$page->{Contents};
1088 0           delete $page->{Contents};
1089 0           my $content=$page->gfx();
1090 0           $content->add(" $trans ");
1091            
1092 0 0         if($self->default('pageencaps'))
1093             {
1094 0           $content->{' stream'}.=" q ";
1095             }
1096 0           foreach my $k ($uncontent->elementsof)
1097             {
1098 0           $k->realise;
1099 0           $content->{' stream'}.=" ".unfilter($k->{Filter}, $k->{' stream'})." ";
1100             }
1101 0 0         if($self->default('pageencaps'))
1102             {
1103 0           $content->{' stream'}.=" Q ";
1104             }
1105            
1106             ## $content->{Length}=PDFNum(length($content->{' stream'}));
1107             # this will be fixed by the following code or content or filters
1108            
1109             ## if we like compress we will do it now to do quicker saves
1110 0 0         if($self->{forcecompress}>0){
1111             ## $content->compressFlate;
1112 0           $content->{' stream'}=dofilter($content->{Filter}, $content->{' stream'});
1113 0           $content->{' nofilt'}=1;
1114 0           delete $content->{-docompress};
1115 0           $content->{Length}=PDFNum(length($content->{' stream'}));
1116             }
1117 0           $page->{' fixed'}=1;
1118             }
1119             }
1120            
1121 0           $self->{pdf}->out_obj($page);
1122 0           $self->{pdf}->out_obj($self->{pages});
1123 0           $page->{' apipdf'}=$self->{pdf};
1124 0           $page->{' api'}=$self;
1125 0           $page->{' reopened'}=1;
1126 0           return($page);
1127             }
1128            
1129            
1130             # $target_object = walk_obj $obj_cache, $source_pdf, $target_pdf, $source_object [, @keys_to_copy ]
1131            
1132             sub walk_obj {
1133 0     0 0   my ($objs,$spdf,$tpdf,$obj,@keys)=@_;
1134            
1135 0           my $tobj;
1136            
1137            
1138 0 0         if(ref($obj)=~/Objind$/) {
1139 0           $obj->realise;
1140             }
1141            
1142 0 0         return($objs->{scalar $obj}) if(defined $objs->{scalar $obj});
1143             ####die "infinite loop while copying objects" if($obj->{' copied'});
1144            
1145 0           $tobj=$obj->copy($spdf); ## thanks to: yaheath // Fri, 17 Sep 2004
1146            
1147             ####$obj->{' copied'}=1;
1148 0 0         $tpdf->new_obj($tobj) if($obj->is_obj($spdf));
1149            
1150 0           $objs->{scalar $obj}=$tobj;
1151            
1152 0 0         if(ref($obj)=~/Array$/) {
    0          
1153 0           $tobj->{' val'}=[];
1154 0           foreach my $k ($obj->elementsof) {
1155 0 0         $k->realise if(ref($k)=~/Objind$/);
1156 0           $tobj->add_elements(walk_obj($objs,$spdf,$tpdf,$k));
1157             }
1158             } elsif(ref($obj)=~/Dict$/) {
1159 0 0         @keys=keys(%{$tobj}) if(scalar @keys <1);
  0            
1160 0           foreach my $k (@keys) {
1161 0 0         next if($k=~/^ /);
1162 0 0         next unless(defined($obj->{$k}));
1163 0           $tobj->{$k}=walk_obj($objs,$spdf,$tpdf,$obj->{$k});
1164             }
1165 0 0         if($obj->{' stream'}) {
1166 0 0         if($tobj->{Filter}) {
1167 0           $tobj->{' nofilt'}=1;
1168             } else {
1169 0           delete $tobj->{' nofilt'};
1170 0           $tobj->{Filter}=PDFArray(PDFName('FlateDecode'));
1171             }
1172 0           $tobj->{' stream'}=$obj->{' stream'};
1173             }
1174             }
1175 0           delete $tobj->{' streamloc'};
1176 0           delete $tobj->{' streamsrc'};
1177 0           return($tobj);
1178             }
1179            
1180             =item $xoform = $pdf->importPageIntoForm $sourcepdf, $sourceindex
1181            
1182             Returns a form-xobject created from $sourcepdf,$sourceindex.
1183             This is useful if you want to transpose the imported page-description
1184             somewhat differently onto a page (ie. two-up, four-up, duplex, etc.).
1185            
1186             B on $index
1187            
1188             -1,0 ... returns the last page
1189             1 ... returns page number 1
1190            
1191             B
1192            
1193             $pdf = PDF::API3::Compat::API2->new;
1194             $old = PDF::API3::Compat::API2->open('my/old.pdf');
1195             $xo = $pdf->importPageIntoForm($old,2); # get page 2
1196             $page = $pdf->page;
1197             $gfx = $page->gfx;
1198             $gfx->formimage($xo,0,0,1); # put it on page 1 with scale x1
1199             $pdf->saveas("our/new.pdf");
1200            
1201             B you can only import a page from an existing pdf-file!
1202            
1203             =cut
1204            
1205             sub importPageIntoForm {
1206 0     0 1   my $self=shift @_;
1207 0           my $s_pdf=shift @_;
1208 0   0       my $s_idx=shift @_||0;
1209            
1210 0 0         UNIVERSAL::isa($s_pdf, 'PDF::API3::Compat::API2') || die "Invalid usage: 1st argument must be PDF::API3::Compat::API2 instance, not: ".ref($s_pdf);
1211            
1212 0           my ($s_page,$xo);
1213            
1214 0           $xo=$self->xo_form;
1215            
1216 0 0         if(ref($s_idx) eq 'PDF::API3::Compat::API2::Page') {
1217 0           $s_page=$s_idx;
1218             } else {
1219 0           $s_page=$s_pdf->openpage($s_idx);
1220             }
1221            
1222 0   0       $self->{apiimportcache}||={};
1223 0   0       $self->{apiimportcache}->{$s_pdf}||={};
1224            
1225 0           foreach my $k (qw( MediaBox ArtBox TrimBox BleedBox CropBox )) {
1226             #next unless(defined $s_page->{$k});
1227             #my $box = walk_obj($self->{apiimportcache}->{$s_pdf},$s_pdf->{pdf},$self->{pdf},$s_page->{$k});
1228 0 0         next unless(defined $s_page->find_prop($k));
1229 0           my $box = walk_obj($self->{apiimportcache}->{$s_pdf},$s_pdf->{pdf},$self->{pdf},$s_page->find_prop($k));
1230 0           $xo->bbox(map { $_->val } $box->elementsof);
  0            
1231 0           last;
1232             }
1233 0 0         $xo->bbox( 0, 0, 612, 792) unless(defined $xo->{BBox});
1234            
1235 0           foreach my $k (qw( Resources )) {
1236 0           $s_page->{$k}=$s_page->find_prop($k);
1237 0 0         next unless(defined $s_page->{$k});
1238 0 0         $s_page->{$k}->realise if(ref($s_page->{$k})=~/Objind$/);
1239            
1240 0           foreach my $sk (qw( XObject ExtGState Font ProcSet Properties ColorSpace Pattern Shading )) {
1241 0 0         next unless(defined $s_page->{$k}->{$sk});
1242 0 0         $s_page->{$k}->{$sk}->realise if(ref($s_page->{$k}->{$sk})=~/Objind$/);
1243 0           foreach my $ssk (keys %{$s_page->{$k}->{$sk}}) {
  0            
1244 0 0         next if($ssk=~/^ /);
1245 0           $xo->resource($sk,$ssk,walk_obj($self->{apiimportcache}->{$s_pdf},$s_pdf->{pdf},$self->{pdf},$s_page->{$k}->{$sk}->{$ssk}));
1246             }
1247             }
1248             }
1249            
1250             # create a whole content stream
1251             ## technically it is possible to submit an unfinished
1252             ## (eg. newly created) source-page, but thats non-sense,
1253             ## so we expect a page fixed by openpage and die otherwise
1254 0 0         die "page not processed via openpage ... " unless($s_page->{' fixed'}==1);
1255            
1256             # since the source page comes from openpage it may already
1257             # contain the required starting 'q' without the final 'Q'
1258             # if forcecompress is in effect
1259 0 0         if(defined $s_page->{Contents}) {
1260 0           $s_page->fixcontents;
1261            
1262 0           $xo->{' stream'}="";
1263             # openpage pages only contain one stream
1264 0           my ($k)=$s_page->{Contents}->elementsof;
1265 0           $k->realise;
1266 0 0         if($k->{' nofilt'}) {
1267             # we have a finished stream here
1268             # so we unfilter
1269 0           $xo->add('q',unfilter($k->{Filter}, $k->{' stream'}),'Q');
1270             } else {
1271             # stream is an unfinished/unfiltered content
1272             # so we just copy it and add the required "qQ"
1273 0           $xo->add('q',$k->{' stream'},'Q');
1274             }
1275 0 0         $xo->compressFlate if($self->{forcecompress}>0);
1276             }
1277            
1278 0           return($xo);
1279             }
1280            
1281             =item $pageobj = $pdf->importpage $sourcepdf, $sourceindex, $targetindex
1282            
1283             Returns the pageobject of page $targetindex, imported from $sourcepdf,$sourceindex.
1284            
1285             B on $index
1286            
1287             -1,0 ... returns the last page
1288             1 ... returns page number 1
1289            
1290             B you can specify a page object instead as $targetindex
1291             so that the contents of the sourcepage will be 'merged into'.
1292            
1293             B
1294            
1295             $pdf = PDF::API3::Compat::API2->new;
1296             $old = PDF::API3::Compat::API2->open('my/old.pdf');
1297             $page = $pdf->importpage($old,2); # get page 2 into page 1
1298             $pdf->saveas("our/new.pdf");
1299            
1300             B you can only import a page from an existing pdf-file!
1301            
1302             =cut
1303            
1304             # B the interactive forms of a page will also be imported, but may
1305             # cause problems if forms of another document have already been imported.
1306            
1307             sub importpage {
1308 0     0 1   my $self=shift @_;
1309 0           my $s_pdf=shift @_;
1310 0   0       my $s_idx=shift @_||0;
1311 0   0       my $t_idx=shift @_||0;
1312 0           my ($s_page,$t_page);
1313            
1314 0 0         UNIVERSAL::isa($s_pdf, 'PDF::API3::Compat::API2') || die "Invalid usage: 1st argument must be PDF::API3::Compat::API2 instance, not: ".ref($s_pdf);
1315            
1316 0 0         if(ref($s_idx) eq 'PDF::API3::Compat::API2::Page') {
1317 0           $s_page=$s_idx;
1318             } else {
1319 0           $s_page=$s_pdf->openpage($s_idx);
1320             }
1321            
1322 0 0         if(ref($t_idx) eq 'PDF::API3::Compat::API2::Page') {
1323 0           $t_page=$t_idx;
1324             } else {
1325 0 0         if($self->pages<$t_idx) {
1326 0           $t_page=$self->page;
1327             } else {
1328 0           $t_page=$self->page($t_idx);
1329             }
1330             }
1331            
1332 0   0       $self->{apiimportcache}=$self->{apiimportcache}||{};
1333 0   0       $self->{apiimportcache}->{$s_pdf}=$self->{apiimportcache}->{$s_pdf}||{};
1334            
1335             # we now import into a form to keep
1336             # all that nasty resources from polluting
1337             # our very own resource naming space.
1338 0           my $xo = $self->importPageIntoForm($s_pdf,$s_page);
1339 0 0         $t_page->mediabox( map { $_->val } $xo->{BBox}->elementsof) if(defined $xo->{BBox});
  0            
1340 0           $t_page->gfx->formimage($xo,0,0,1);
1341            
1342             # copy annotations and/or form elements as well
1343 0 0 0       if (exists $s_page->{Annots} and $s_page->{Annots} and $self->{copyannots}) {
      0        
1344            
1345             # first set up the AcroForm, if required
1346 0           my $AcroForm;
1347 0 0         if (my $a = $s_pdf->{pdf}->{Root}->realise->{AcroForm}) {
1348 0           $a->realise;
1349            
1350 0           $AcroForm = walk_obj({},$s_pdf->{pdf},$self->{pdf},$a,qw( NeedAppearances SigFlags CO DR DA Q ));
1351             }
1352 0           my @Fields = ();
1353 0           my @Annots = ();
1354 0           foreach my $a ($s_page->{Annots}->elementsof) {
1355 0           $a->realise;
1356 0           my $t_a = PDFDict();
1357 0           $self->{pdf}->new_obj($t_a);
1358             # these objects are likely to be both annotations and Acroform fields
1359             # key names are copied from PDF Reference 1.4 (Tables)
1360 0           my @k = (
1361             qw( Type Subtype Contents P Rect NM M F BS Border AP AS C CA T Popup A AA StructParent Rotate
1362             ), # Annotations - Common (8.10)
1363             qw( Subtype Contents Open Name ), # Text Annotations (8.15)
1364             qw( Subtype Contents Dest H PA ), # Link Annotations (8.16)
1365             qw( Subtype Contents DA Q ), # Free Text Annotations (8.17)
1366             qw( Subtype Contents L BS LE IC ) , # Line Annotations (8.18)
1367             qw( Subtype Contents BS IC ), # Square and Circle Annotations (8.20)
1368             qw( Subtype Contents QuadPoints ), # Markup Annotations (8.21)
1369             qw( Subtype Contents Name ), # Rubber Stamp Annotations (8.22)
1370             qw( Subtype Contents InkList BS ), # Ink Annotations (8.23)
1371             qw( Subtype Contents Parent Open ), # Popup Annotations (8.24)
1372             qw( Subtype FS Contents Name ), # File Attachment Annotations (8.25)
1373             qw( Subtype Sound Contents Name ), # Sound Annotations (8.26)
1374             qw( Subtype Movie Contents A ), # Movie Annotations (8.27)
1375             qw( Subtype Contents H MK ), # Widget Annotations (8.28)
1376             # Printers Mark Annotations (none)
1377             # Trap Network Annotations (none)
1378             );
1379 0 0         push @k, (
1380             qw( Subtype FT Parent Kids T TU TM Ff V DV AA
1381             ), # Fields - Common (8.49)
1382             qw( DR DA Q ), # Fields containing variable text (8.51)
1383             qw( Opt ), # Checkbox field (8.54)
1384             qw( Opt ), # Radio field (8.55)
1385             qw( MaxLen ), # Text field (8.57)
1386             qw( Opt TI I ), # Choice field (8.59)
1387             ) if $AcroForm;
1388             # sorting out dups
1389 0           my %ky=map { $_ => 1 } @k;
  0            
1390             # we do P separately, as it points to the page the Annotation is on
1391 0           delete $ky{P};
1392             # copy everything else
1393 0           foreach my $k (keys %ky) {
1394 0 0         next unless defined $a->{$k};
1395 0           $a->{$k}->realise;
1396 0           $t_a->{$k} = walk_obj({},$s_pdf->{pdf},$self->{pdf},$a->{$k});
1397             }
1398 0           $t_a->{P} = $t_page;
1399 0           push @Annots, $t_a;
1400 0 0 0       push @Fields, $t_a if ($AcroForm and $t_a->{Subtype}->val eq 'Widget');
1401             }
1402 0           $t_page->{Annots} = PDFArray(@Annots);
1403 0 0         $AcroForm->{Fields} = PDFArray(@Fields) if $AcroForm;
1404 0           $self->{pdf}->{Root}->{AcroForm} = $AcroForm;
1405             }
1406 0           $t_page->{' imported'} = 1;
1407            
1408 0           $self->{pdf}->out_obj($t_page);
1409 0           $self->{pdf}->out_obj($self->{pages});
1410            
1411 0           return($t_page);
1412             }
1413            
1414             =item $pagenumber = $pdf->pages
1415            
1416             Returns the number of pages in the document.
1417            
1418             =cut
1419            
1420             sub pages {
1421 0     0 1   my $self=shift @_;
1422 0           return scalar @{$self->{pagestack}};
  0            
1423             }
1424            
1425             =item $pdf->mediabox $name
1426            
1427             =item $pdf->mediabox $w, $h
1428            
1429             =item $pdf->mediabox $llx, $lly, $urx, $ury
1430            
1431             Sets the global mediabox. Other methods: cropbox, bleedbox, trimbox and artbox.
1432            
1433             B
1434            
1435             $pdf = PDF::API3::Compat::API2->new;
1436             $pdf->mediabox('A4');
1437             ...
1438             $pdf->saveas("our/new.pdf");
1439            
1440             $pdf = PDF::API3::Compat::API2->new;
1441             $pdf->mediabox(595,842);
1442             ...
1443             $pdf->saveas("our/new.pdf");
1444            
1445             $pdf = PDF::API3::Compat::API2->new;
1446             $pdf->mediabox(0,0,595,842);
1447             ...
1448             $pdf->saveas("our/new.pdf");
1449            
1450            
1451             =cut
1452            
1453             sub mediabox {
1454 0     0 1   my ($self,$x1,$y1,$x2,$y2) = @_;
1455 0           $self->{pages}->{'MediaBox'}=PDFArray( map { PDFNum(float($_)) } page_size($x1,$y1,$x2,$y2) );
  0            
1456 0           $self;
1457             }
1458            
1459             =item $pdf->cropbox $name
1460            
1461             =item $pdf->cropbox $w, $h
1462            
1463             =item $pdf->cropbox $llx, $lly, $urx, $ury
1464            
1465             Sets the global cropbox.
1466            
1467             B
1468            
1469             $pdf = PDF::API3::Compat::API2->new;
1470             $pdf->cropbox('A4');
1471             ...
1472             $pdf->saveas("our/new.pdf");
1473            
1474             $pdf = PDF::API3::Compat::API2->new;
1475             $pdf->cropbox(595,842);
1476             ...
1477             $pdf->saveas("our/new.pdf");
1478            
1479             $pdf = PDF::API3::Compat::API2->new;
1480             $pdf->cropbox(0,0,595,842);
1481             ...
1482             $pdf->saveas("our/new.pdf");
1483            
1484             =cut
1485            
1486             sub cropbox {
1487 0     0 1   my ($self,$x1,$y1,$x2,$y2) = @_;
1488 0           $self->{pages}->{'CropBox'}=PDFArray( map { PDFNum(float($_)) } page_size($x1,$y1,$x2,$y2) );
  0            
1489 0           $self;
1490             }
1491            
1492             =item $pdf->bleedbox $name
1493            
1494             =item $pdf->bleedbox $w, $h
1495            
1496             =item $pdf->bleedbox $llx, $lly, $urx, $ury
1497            
1498             Sets the global bleedbox.
1499            
1500             B
1501            
1502             $pdf = PDF::API3::Compat::API2->new;
1503             $pdf->bleedbox('A4');
1504             ...
1505             $pdf->saveas("our/new.pdf");
1506            
1507             $pdf = PDF::API3::Compat::API2->new;
1508             $pdf->bleedbox(595,842);
1509             ...
1510             $pdf->saveas("our/new.pdf");
1511            
1512             $pdf = PDF::API3::Compat::API2->new;
1513             $pdf->bleedbox(0,0,595,842);
1514             ...
1515             $pdf->saveas("our/new.pdf");
1516            
1517             =cut
1518            
1519             sub bleedbox {
1520 0     0 1   my ($self,$x1,$y1,$x2,$y2) = @_;
1521 0           $self->{pages}->{'BleedBox'}=PDFArray( map { PDFNum(float($_)) } page_size($x1,$y1,$x2,$y2) );
  0            
1522 0           $self;
1523             }
1524            
1525             =item $pdf->trimbox $name
1526            
1527             =item $pdf->trimbox $w, $h
1528            
1529             =item $pdf->trimbox $llx, $lly, $urx, $ury
1530            
1531             Sets the global trimbox.
1532            
1533             B
1534            
1535             $pdf = PDF::API3::Compat::API2->new;
1536             $pdf->trimbox('A4');
1537             ...
1538             $pdf->saveas("our/new.pdf");
1539            
1540             $pdf = PDF::API3::Compat::API2->new;
1541             $pdf->trimbox(595,842);
1542             ...
1543             $pdf->saveas("our/new.pdf");
1544            
1545             $pdf = PDF::API3::Compat::API2->new;
1546             $pdf->trimbox(0,0,595,842);
1547             ...
1548             $pdf->saveas("our/new.pdf");
1549            
1550             =cut
1551            
1552             sub trimbox {
1553 0     0 1   my ($self,$x1,$y1,$x2,$y2) = @_;
1554 0           $self->{pages}->{'TrimBox'}=PDFArray( map { PDFNum(float($_)) } page_size($x1,$y1,$x2,$y2) );
  0            
1555 0           $self;
1556             }
1557            
1558             =item $pdf->artbox $name
1559            
1560             =item $pdf->artbox $w, $h
1561            
1562             =item $pdf->artbox $llx, $lly, $urx, $ury
1563            
1564             Sets the global artbox.
1565            
1566             B
1567            
1568             $pdf = PDF::API3::Compat::API2->new;
1569             $pdf->artbox('A4');
1570             ...
1571             $pdf->saveas("our/new.pdf");
1572            
1573             $pdf = PDF::API3::Compat::API2->new;
1574             $pdf->artbox(595,842);
1575             ...
1576             $pdf->saveas("our/new.pdf");
1577            
1578             $pdf = PDF::API3::Compat::API2->new;
1579             $pdf->artbox(0,0,595,842);
1580             ...
1581             $pdf->saveas("our/new.pdf");
1582            
1583             =cut
1584            
1585             sub artbox {
1586 0     0 1   my ($self,$x1,$y1,$x2,$y2) = @_;
1587 0           $self->{pages}->{'ArtBox'}=PDFArray( map { PDFNum(float($_)) } page_size($x1,$y1,$x2,$y2) );
  0            
1588 0           $self;
1589             }
1590            
1591             =back
1592            
1593             =head1 FONT METHODS
1594            
1595             =over 4
1596            
1597             =item @allFontDirs = PDF::API3::Compat::API2::addFontDirs $dir1, ..., $dirN
1598            
1599             Adds one or more directories to the search-path for finding font files.
1600             Returns the list of searched directories.
1601            
1602             =cut
1603            
1604             sub addFontDirs {
1605 0     0 1   push( @FontDirs, @_ );
1606 0           return( @FontDirs );
1607             }
1608            
1609             sub _findFont {
1610 0     0     my $font=shift @_;
1611 0           my @fonts=($font,map { "$_/$font" } @FontDirs);
  0            
1612 0   0       while((scalar @fonts > 0) && (! -f $fonts[0])) { shift @fonts; }
  0            
1613 0           return($fonts[0]);
1614             }
1615            
1616             =item $font = $pdf->corefont $fontname [, %options]
1617            
1618             Returns a new adobe core font object.
1619            
1620             =cut
1621            
1622             =pod
1623            
1624             See L for an explanation.
1625            
1626            
1627             B
1628            
1629             $font = $pdf->corefont('Times-Roman');
1630             $font = $pdf->corefont('Times-Bold');
1631             $font = $pdf->corefont('Helvetica');
1632             $font = $pdf->corefont('ZapfDingbats');
1633            
1634            
1635             Valid %options are:
1636            
1637             '-encode' ... changes the encoding of the font from its default.
1638            
1639             '-dokern' ... enables kerning if data is available.
1640            
1641             =cut
1642            
1643             sub corefont {
1644 0     0 1   my ($self,$name,@opts)=@_;
1645 0           my $obj=PDF::API3::Compat::API2::Resource::Font::CoreFont->new_api($self,$name,@opts);
1646 0           $self->resource('Font',$obj->name,$obj);
1647 0           $self->{pdf}->out_obj($self->{pages});
1648 0 0         $obj->tounicodemap if($opts{-unicodemap}==1);
1649 0           return($obj);
1650             }
1651            
1652             =item $font = $pdf->psfont $psfile [, %options]
1653            
1654             Returns a new adobe type1 font object.
1655            
1656             =cut
1657            
1658             =pod
1659            
1660             See L for an explanation.
1661            
1662             B
1663            
1664             $font = $pdf->psfont( 'Times-Book.pfa', -afmfile => 'Times-Book.afm' );
1665             $font = $pdf->psfont( '/fonts/Synest-FB.pfb', -pfmfile => '/fonts/Synest-FB.pfm' );
1666            
1667             Valid %options are:
1668            
1669             '-encode' ... changes the encoding of the font from its default.
1670            
1671             '-afmfile' ... specifies that font metrics to be read from the
1672             adobe font metrics file (AFM).
1673            
1674             '-pfmfile' ... specifies that font metrics to be read from the
1675             windows printer font metrics file (PFM).
1676             (this option overrides the -encode option)
1677            
1678             '-dokern' ... enables kerning if data is available.
1679            
1680             =cut
1681            
1682             sub psfont {
1683 0     0 1   my ($self,$psf,%opts)=@_;
1684            
1685 0           foreach my $o (qw(-afmfile -pfmfile)) {
1686 0 0         next unless(defined $opts{$o});
1687 0           $opts{$o}=_findFont($opts{$o});
1688             }
1689 0           $psf=_findFont($psf);
1690 0           my $obj=PDF::API3::Compat::API2::Resource::Font::Postscript->new_api($self,$psf,%opts);
1691            
1692 0           $self->resource('Font',$obj->name,$obj,$self->{reopened});
1693            
1694 0           $self->{pdf}->out_obj($self->{pages});
1695 0 0         $obj->tounicodemap if($opts{-unicodemap}==1);
1696 0           return($obj);
1697             }
1698            
1699             =item $font = $pdf->ttfont $ttfile [, %options]
1700            
1701             Returns a new truetype or opentype font object.
1702            
1703             =cut
1704            
1705             =pod
1706            
1707             See L for an explanation.
1708            
1709             B
1710            
1711             $font = $pdf->ttfont('Times.ttf');
1712             $font = $pdf->ttfont('Georgia.otf');
1713            
1714             Valid %options are:
1715            
1716             '-encode' ... changes the encoding of the font from its default.
1717            
1718             '-isocmap' ... per default the MS Unicode Map is used, if this
1719             option is given the ISO Unicode Map will be used.
1720            
1721             '-dokern' ... enables kerning if data is available.
1722            
1723             '-noembed' ... disables embedding the fontfile.
1724            
1725             =cut
1726            
1727             sub ttfont {
1728 0     0 1   my ($self,$file,%opts)=@_;
1729            
1730 0           $file=_findFont($file);
1731 0           my $obj=PDF::API3::Compat::API2::Resource::CIDFont::TrueType->new_api($self,$file,%opts);
1732            
1733 0           $self->resource('Font',$obj->name,$obj,$self->{reopened});
1734            
1735 0           $self->{pdf}->out_obj($self->{pages});
1736 0 0         $obj->tounicodemap if($opts{-unicodemap}==1);
1737 0           return($obj);
1738             }
1739            
1740             sub nettfont {
1741 0     0 0   my ($self,$file,%opts)=@_;
1742            
1743 0           $file=_findFont($file);
1744 0           my $obj=PDF::API3::Compat::API2::Resource::Font::neTrueType->new_api($self,$file,%opts);
1745            
1746 0           $self->resource('Font',$obj->name,$obj,$self->{reopened});
1747            
1748 0           $self->{pdf}->out_obj($self->{pages});
1749 0 0         $obj->tounicodemap if($opts{-unicodemap}==1);
1750 0           return($obj);
1751             }
1752            
1753             =item $font = $pdf->cjkfont $cjkname [, %options]
1754            
1755             Returns a new cjk font object.
1756            
1757             =cut
1758            
1759             =pod
1760            
1761             See L for an explanation.
1762            
1763             B
1764            
1765             $font = $pdf->cjkfont('korean');
1766             $font = $pdf->cjkfont('traditional');
1767            
1768             Valid %options are:
1769            
1770             '-encode' ... changes the encoding of the font from its default.
1771            
1772             =cut
1773            
1774             sub cjkfont {
1775 0     0 1   my ($self,$name,%opts)=@_;
1776            
1777 0           my $obj=PDF::API3::Compat::API2::Resource::CIDFont::CJKFont->new_api($self,$name,%opts);
1778            
1779 0           $self->resource('Font',$obj->name,$obj,$self->{reopened});
1780            
1781 0           $self->{pdf}->out_obj($self->{pages});
1782 0 0         $obj->tounicodemap if($opts{-unicodemap}==1);
1783 0           return($obj);
1784             }
1785            
1786             =item $font = $pdf->synfont $basefont [, %options]
1787            
1788             Returns a new synthetic font object.
1789            
1790             =cut
1791            
1792             =pod
1793            
1794             See L for an explanation.
1795            
1796             B
1797            
1798             $cf = $pdf->corefont('Times-Roman',-encode=>'latin1');
1799             $sf = $pdf->synfont($cf,-slant=>0.85); # compressed 85%
1800             $sfb= $pdf->synfont($cf,-bold=>1); # embolden by 10em
1801             $sfi= $pdf->synfont($cf,-oblique=>-12); # italic at -12 degrees
1802            
1803             Valid %options are:
1804            
1805             I<-slant>
1806             ... slant/expansion factor (0.1-0.9 = slant, 1.1+ = expansion).
1807            
1808             I<-oblique>
1809             ... italic angle (+/-)
1810            
1811             I<-bold>
1812             ... embolding factor (0.1+, bold=1, heavy=2, ...)
1813            
1814             I<-space>
1815             ... additional charspacing in em (0-1000)
1816            
1817             =cut
1818            
1819             sub synfont {
1820 0     0 1   my ($self,@opts)=@_;
1821            
1822 0           my $obj=PDF::API3::Compat::API2::Resource::Font::SynFont->new_api($self,@opts);
1823            
1824 0           $self->resource('Font',$obj->name,$obj,$self->{reopened});
1825            
1826 0           $self->{pdf}->out_obj($self->{pages});
1827 0 0         $obj->tounicodemap if($opts{-unicodemap}==1);
1828 0           return($obj);
1829             }
1830            
1831             =item $font = $pdf->bdfont $bdffile
1832            
1833             Returns a new BDF font object, based on the specified adobe-bdf file.
1834            
1835             =cut
1836            
1837             =pod
1838            
1839             See L for an explanation.
1840            
1841             =cut
1842            
1843             sub bdfont {
1844 0     0 1   my ($self,@opts)=@_;
1845            
1846 0           my $obj=PDF::API3::Compat::API2::Resource::Font::BdFont->new_api($self,@opts);
1847            
1848 0           $self->resource('Font',$obj->name,$obj,$self->{reopened});
1849            
1850 0           $self->{pdf}->out_obj($self->{pages});
1851             ## $obj->tounicodemap; # does not support unicode!
1852 0           return($obj);
1853             }
1854            
1855             =item $font = $pdf->unifont @fontspecs, %options
1856            
1857             Returns a new uni-font object, based on the specified fonts and options.
1858            
1859             =cut
1860            
1861             =pod
1862            
1863             B This is not a true pdf-object, but a virtual/abstract font-definition !
1864            
1865             See L for an explanation.
1866            
1867             Valid %options are:
1868            
1869             '-encode' ... changes the encoding of the font from its default.
1870            
1871             =cut
1872            
1873             sub unifont {
1874 0     0 1   my ($self,@opts)=@_;
1875            
1876 0           my $obj=PDF::API3::Compat::API2::Resource::UniFont->new_api($self,@opts);
1877            
1878 0           return($obj);
1879             }
1880            
1881             =back
1882            
1883             =head1 IMAGE METHODS
1884            
1885             =over 4
1886            
1887             =item $jpeg = $pdf->image_jpeg $file
1888            
1889             Returns a new jpeg image object.
1890            
1891             =cut
1892            
1893             sub image_jpeg {
1894 0     0 1   my ($self,$file,%opts)=@_;
1895            
1896 0           my $obj=PDF::API3::Compat::API2::Resource::XObject::Image::JPEG->new_api($self,$file);
1897            
1898 0           $self->resource('XObject',$obj->name,$obj);
1899            
1900 0           $self->{pdf}->out_obj($self->{pages});
1901 0           return($obj);
1902             }
1903            
1904             =item $tiff = $pdf->image_tiff $file
1905            
1906             Returns a new tiff image object.
1907            
1908             =cut
1909            
1910             sub image_tiff {
1911 0     0 1   my ($self,$file,%opts)=@_;
1912            
1913 0           my $obj=PDF::API3::Compat::API2::Resource::XObject::Image::TIFF->new_api($self,$file);
1914            
1915 0           $self->resource('XObject',$obj->name,$obj);
1916            
1917 0           $self->{pdf}->out_obj($self->{pages});
1918 0           return($obj);
1919             }
1920            
1921             =item $pnm = $pdf->image_pnm $file
1922            
1923             Returns a new pnm image object.
1924            
1925             =cut
1926            
1927             sub image_pnm {
1928 0     0 1   my ($self,$file,%opts)=@_;
1929            
1930 0           my $obj=PDF::API3::Compat::API2::Resource::XObject::Image::PNM->new_api($self,$file);
1931            
1932 0           $self->resource('XObject',$obj->name,$obj);
1933            
1934 0           $self->{pdf}->out_obj($self->{pages});
1935 0           return($obj);
1936             }
1937            
1938             =item $png = $pdf->image_png $file
1939            
1940             Returns a new png image object.
1941            
1942             =cut
1943            
1944             sub image_png {
1945 0     0 1   my ($self,$file,%opts)=@_;
1946            
1947 0           my $obj=PDF::API3::Compat::API2::Resource::XObject::Image::PNG->new_api($self,$file);
1948            
1949 0           $self->resource('XObject',$obj->name,$obj);
1950            
1951 0           $self->{pdf}->out_obj($self->{pages});
1952 0           return($obj);
1953             }
1954            
1955             =item $gif = $pdf->image_gif $file
1956            
1957             Returns a new gif image object.
1958            
1959             =cut
1960            
1961             sub image_gif {
1962 0     0 1   my ($self,$file,%opts)=@_;
1963            
1964 0           my $obj=PDF::API3::Compat::API2::Resource::XObject::Image::GIF->new_api($self,$file);
1965            
1966 0           $self->resource('XObject',$obj->name,$obj);
1967            
1968 0           $self->{pdf}->out_obj($self->{pages});
1969 0           return($obj);
1970             }
1971            
1972             =item $gdf = $pdf->image_gd $gdobj, %options
1973            
1974             Returns a new image object from GD::Image.
1975            
1976             B The only option currently supported is C<-lossless =E 1>.
1977            
1978             =cut
1979            
1980             sub image_gd {
1981 0     0 1   my ($self,$gd,%opts)=@_;
1982            
1983 0           my $obj=PDF::API3::Compat::API2::Resource::XObject::Image::GD->new_api($self,$gd,undef,%opts);
1984            
1985 0           $self->resource('XObject',$obj->name,$obj);
1986            
1987 0           $self->{pdf}->out_obj($self->{pages});
1988 0           return($obj);
1989             }
1990            
1991             #=item $img = $pdf->image_rgb $file_or_ref, %options
1992             #
1993             #Returns a new image object from a raw RGB image.
1994             #
1995             #B C<-width>, C<-height>, C<-bits> (required).
1996             #
1997             #=cut
1998             #
1999             #sub image_rgb {
2000             # my ($self,$rgb,@opts)=@_;
2001             #
2002             # my $obj=PDF::API3::Compat::API2::Resource::XObject::Image::RGBA->new_api($self,$rgb,-alpha=>0,@opts);
2003             #
2004             # $self->resource('XObject',$obj->name,$obj);
2005             #
2006             # $self->{pdf}->out_obj($self->{pages});
2007             # return($obj);
2008             #}
2009            
2010             #=item $img = $pdf->image_rgba $file_or_ref, %options
2011             #
2012             #Returns a new image object from a raw RGBA image.
2013             #
2014             #B C<-width>, C<-height>, C<-bits> (required).
2015             #
2016             #=cut
2017             #
2018             #sub image_rgba {
2019             # my ($self,$rgb,@opts)=@_;
2020             #
2021             # my $obj=PDF::API3::Compat::API2::Resource::XObject::Image::RGBA->new_api($self,$rgb,-alpha=>1,@opts);
2022             #
2023             # $self->resource('XObject',$obj->name,$obj);
2024             #
2025             # $self->{pdf}->out_obj($self->{pages});
2026             # return($obj);
2027             #}
2028            
2029             #=item $img = $pdf->image_cmyk $file_or_ref, %options
2030             #
2031             #Returns a new image object from a raw CMYK image.
2032             #
2033             #B C<-width>, C<-height>, C<-bits> (required).
2034             #
2035             #=cut
2036             #
2037             #sub image_cmyk {
2038             # my ($self,$rgb,@opts)=@_;
2039             #
2040             # my $obj=PDF::API3::Compat::API2::Resource::XObject::Image::CMYKA->new_api($self,$rgb,-alpha=>0,@opts);
2041             #
2042             # $self->resource('XObject',$obj->name,$obj);
2043             #
2044             # $self->{pdf}->out_obj($self->{pages});
2045             # return($obj);
2046             #}
2047            
2048             #=item $img = $pdf->image_cmyka $file_or_ref, %options
2049             #
2050             #Returns a new image object from a raw CMYKA image.
2051             #
2052             #B C<-width>, C<-height>, C<-bits> (required).
2053             #
2054             #=cut
2055             #
2056             #sub image_cmyka {
2057             # my ($self,$rgb,@opts)=@_;
2058             #
2059             # my $obj=PDF::API3::Compat::API2::Resource::XObject::Image::CMYKA->new_api($self,$rgb,-alpha=>1,@opts);
2060             #
2061             # $self->resource('XObject',$obj->name,$obj);
2062             #
2063             # $self->{pdf}->out_obj($self->{pages});
2064             # return($obj);
2065             #}
2066            
2067             #=item $img = $pdf->image_indexed $file_or_ref, %options
2068             #
2069             #Returns a new image object from a raw indexed image.
2070             #
2071             #B C<-width>, C<-height>, C<-bits>, C<-colorspace> (required).
2072             #
2073             #=cut
2074             #
2075             #sub image_indexed {
2076             # my ($self,$rgb,@opts)=@_;
2077             #
2078             # my $obj=PDF::API3::Compat::API2::Resource::XObject::Image::Indexed->new_api($self,$rgb,-alpha=>0,@opts);
2079             #
2080             # $self->resource('XObject',$obj->name,$obj);
2081             #
2082             # $self->{pdf}->out_obj($self->{pages});
2083             # return($obj);
2084             #}
2085            
2086             #=item $img = $pdf->image_indexedalpha $file_or_ref, %options
2087             #
2088             #Returns a new image object from a raw indexed-alpha image.
2089             #
2090             #B C<-width>, C<-height>, C<-bits>, C<-colorspace> (required).
2091             #
2092             #=cut
2093             #
2094             #sub image_indexedalpha {
2095             # my ($self,$rgb,@opts)=@_;
2096             #
2097             # my $obj=PDF::API3::Compat::API2::Resource::XObject::Image::Indexed->new_api($self,$rgb,-alpha=>1,@opts);
2098             #
2099             # $self->resource('XObject',$obj->name,$obj);
2100             #
2101             # $self->{pdf}->out_obj($self->{pages});
2102             # return($obj);
2103             #}
2104            
2105             =pod
2106            
2107             B
2108            
2109             $jpeg = $pdf->image_jpeg('../some/nice/picture.jpeg');
2110             $tiff = $pdf->image_tiff('../some/nice/picture.tiff');
2111             $pnm = $pdf->image_pnm('../some/nice/picture.pnm');
2112             $png = $pdf->image_png('../some/nice/picture.png');
2113             $gif = $pdf->image_gif('../some/nice/picture.gif');
2114             $gdf = $pdf->image_gd($gdobj);
2115            
2116             =back
2117            
2118             =head1 COLORSPACE METHODS
2119            
2120             =over 4
2121            
2122             =item $cs = $pdf->colorspace_act $file
2123            
2124             Returns a new colorspace-object based on a adobe-color-table file.
2125            
2126             =cut
2127            
2128             =pod
2129            
2130             See L for an explanation of the file format.
2131            
2132             =cut
2133            
2134             sub colorspace_act {
2135 0     0 1   my ($self,$file,%opts)=@_;
2136            
2137 0           my $obj=PDF::API3::Compat::API2::Resource::ColorSpace::Indexed::ACTFile->new_api($self,$file);
2138            
2139 0           $self->resource('ColorSpace',$obj->name,$obj);
2140            
2141 0           $self->{pdf}->out_obj($self->{pages});
2142 0           return($obj);
2143             }
2144            
2145             =item $cs = $pdf->colorspace_web
2146            
2147             Returns a new colorspace-object based on the web color palette.
2148            
2149             =cut
2150            
2151             =pod
2152            
2153             See L for an explanation.
2154            
2155             =cut
2156            
2157             sub colorspace_web {
2158 0     0 1   my ($self,$file,%opts)=@_;
2159            
2160 0           my $obj=PDF::API3::Compat::API2::Resource::ColorSpace::Indexed::WebColor->new_api($self);
2161            
2162 0           $self->resource('ColorSpace',$obj->name,$obj);
2163            
2164 0           $self->{pdf}->out_obj($self->{pages});
2165 0           return($obj);
2166             }
2167            
2168             =item $cs = $pdf->colorspace_hue
2169            
2170             Returns a new colorspace-object based on the hue color palette.
2171            
2172             =cut
2173            
2174             =pod
2175            
2176             See L for an explanation.
2177            
2178             =cut
2179            
2180             sub colorspace_hue {
2181 0     0 1   my ($self,$file,%opts)=@_;
2182            
2183 0           my $obj=PDF::API3::Compat::API2::Resource::ColorSpace::Indexed::Hue->new_api($self);
2184            
2185 0           $self->resource('ColorSpace',$obj->name,$obj);
2186            
2187 0           $self->{pdf}->out_obj($self->{pages});
2188 0           return($obj);
2189             }
2190            
2191             =item $cs = $pdf->colorspace_separation $tint, $color
2192            
2193             Returns a new separation colorspace-object based on the parameters.
2194            
2195             =cut
2196            
2197             =pod
2198            
2199             I<$tint> can be any valid ink-identifier, including but not limited to:
2200             'Cyan', 'Magenta', 'Yellow', 'Black', 'Red', 'Green', 'Blue' or 'Orange'.
2201            
2202             I<$color> must be a valid color-specification limited to:
2203             '#rrggbb', '!hhssvv', '%ccmmyykk' or a "named color" (rgb).
2204            
2205             The colorspace model for will be automatically chosen based on the specified color.
2206            
2207             =cut
2208            
2209             sub colorspace_separation {
2210 0     0 1   my ($self,$name,@clr)=@_;
2211 0           my $obj=PDF::API3::Compat::API2::Resource::ColorSpace::Separation->new_api($self,$name,@clr);
2212            
2213 0           $self->resource('ColorSpace',$obj->name,$obj);
2214            
2215 0           $self->{pdf}->out_obj($self->{pages});
2216 0           return($obj);
2217             }
2218            
2219             =item $cs = $pdf->colorspace_devicen \@tintCSx [, $samples]
2220            
2221             Returns a new DeviceN colorspace-object based on the parameters.
2222            
2223             B
2224            
2225             $cy = $pdf->colorspace_separation('Cyan', '%f000');
2226             $ma = $pdf->colorspace_separation('Magenta', '%0f00');
2227             $ye = $pdf->colorspace_separation('Yellow', '%00f0');
2228             $bk = $pdf->colorspace_separation('Black', '%000f');
2229             $pms023 = $pdf->colorspace_separation('PANTONE 032CV', '%0ff0');
2230            
2231             $dncs = $pdf->colorspace_devicen( [ $cy,$ma,$ye,$bk,$pms023 ] );
2232            
2233             =cut
2234            
2235             =pod
2236            
2237             The colorspace model for will be automatically chosen based on the first colorspace specified.
2238            
2239             =cut
2240            
2241             sub colorspace_devicen {
2242 0     0 1   my ($self,$clrs,$samples)=@_;
2243 0   0       $samples||=2;
2244            
2245 0           my $obj=PDF::API3::Compat::API2::Resource::ColorSpace::DeviceN->new_api($self,$clrs,$samples);
2246            
2247 0           $self->resource('ColorSpace',$obj->name,$obj);
2248            
2249 0           $self->{pdf}->out_obj($self->{pages});
2250 0           return($obj);
2251             }
2252            
2253             =back
2254            
2255             =head1 BARCODE METHODS
2256            
2257             =over 4
2258            
2259             =item $bc = $pdf->xo_codabar %opts
2260            
2261             =item $bc = $pdf->xo_code128 %opts
2262            
2263             =item $bc = $pdf->xo_2of5int %opts
2264            
2265             =item $bc = $pdf->xo_3of9 %opts
2266            
2267             =item $bc = $pdf->xo_ean13 %opts
2268            
2269             creates the specified barcode object as a form-xo.
2270            
2271             =cut
2272            
2273             sub xo_code128 {
2274 0     0 1   my ($self,@opts)=@_;
2275            
2276 0           my $obj=PDF::API3::Compat::API2::Resource::XObject::Form::BarCode::code128->new_api($self,@opts);
2277            
2278 0           $self->resource('XObject',$obj->name,$obj);
2279            
2280 0           $self->{pdf}->out_obj($self->{pages});
2281 0           return($obj);
2282             }
2283            
2284             sub xo_codabar {
2285 0     0 1   my ($self,@opts)=@_;
2286            
2287 0           my $obj=PDF::API3::Compat::API2::Resource::XObject::Form::BarCode::codabar->new_api($self,@opts);
2288            
2289 0           $self->resource('XObject',$obj->name,$obj);
2290            
2291 0           $self->{pdf}->out_obj($self->{pages});
2292 0           return($obj);
2293             }
2294            
2295             sub xo_2of5int {
2296 0     0 1   my ($self,@opts)=@_;
2297            
2298 0           my $obj=PDF::API3::Compat::API2::Resource::XObject::Form::BarCode::int2of5->new_api($self,@opts);
2299            
2300 0           $self->resource('XObject',$obj->name,$obj);
2301            
2302 0           $self->{pdf}->out_obj($self->{pages});
2303 0           return($obj);
2304             }
2305            
2306             sub xo_3of9 {
2307 0     0 1   my ($self,@opts)=@_;
2308            
2309 0           my $obj=PDF::API3::Compat::API2::Resource::XObject::Form::BarCode::code3of9->new_api($self,@opts);
2310            
2311 0           $self->resource('XObject',$obj->name,$obj);
2312            
2313 0           $self->{pdf}->out_obj($self->{pages});
2314 0           return($obj);
2315             }
2316            
2317             sub xo_ean13 {
2318 0     0 1   my ($self,@opts)=@_;
2319            
2320 0           my $obj=PDF::API3::Compat::API2::Resource::XObject::Form::BarCode::ean13->new_api($self,@opts);
2321            
2322 0           $self->resource('XObject',$obj->name,$obj);
2323            
2324 0           $self->{pdf}->out_obj($self->{pages});
2325 0           return($obj);
2326             }
2327            
2328             =back
2329            
2330             =head1 OTHER METHODS
2331            
2332             =over 4
2333            
2334             =item $xo = $pdf->xo_form
2335            
2336             Returns a new form-xobject.
2337            
2338             B
2339            
2340             $xo = $pdf->xo_form;
2341            
2342             =cut
2343            
2344             sub xo_form {
2345 0     0 1   my ($self)=@_;
2346            
2347 0           my $obj=PDF::API3::Compat::API2::Resource::XObject::Form::Hybrid->new_api($self);
2348            
2349 0           $self->resource('XObject',$obj->name,$obj);
2350            
2351 0           $self->{pdf}->out_obj($self->{pages});
2352 0           return($obj);
2353             }
2354            
2355             =item $egs = $pdf->egstate
2356            
2357             Returns a new extended graphics state object.
2358            
2359             B
2360            
2361             $egs = $pdf->egstate;
2362            
2363             =cut
2364            
2365             sub egstate {
2366 0     0 1   my ($self)=@_;
2367            
2368 0           my $obj=PDF::API3::Compat::API2::Resource::ExtGState->new_api($self,pdfkey());
2369            
2370 0           $self->resource('ExtGState',$obj->name,$obj);
2371            
2372 0           $self->{pdf}->out_obj($self->{pages});
2373 0           return($obj);
2374             }
2375            
2376             =item $obj = $pdf->pattern
2377            
2378             Returns a new pattern-object.
2379            
2380             =cut
2381            
2382             sub pattern {
2383 0     0 1   my ($self,%opts)=@_;
2384            
2385 0           my $obj=PDF::API3::Compat::API2::Resource::Pattern->new_api($self,undef,%opts);
2386            
2387 0           $self->resource('Pattern',$obj->name,$obj);
2388            
2389 0           $self->{pdf}->out_obj($self->{pages});
2390 0           return($obj);
2391             }
2392            
2393             =item $obj = $pdf->shading
2394            
2395             Returns a new shading-object.
2396            
2397             =cut
2398            
2399             sub shading {
2400 0     0 1   my ($self,%opts)=@_;
2401            
2402 0           my $obj=PDF::API3::Compat::API2::Resource::Shading->new_api($self,undef,%opts);
2403            
2404 0           $self->resource('Shading',$obj->name,$obj);
2405            
2406 0           $self->{pdf}->out_obj($self->{pages});
2407 0           return($obj);
2408             }
2409            
2410             =item $otls = $pdf->outlines
2411            
2412             Returns a new or existing outlines object.
2413            
2414             =cut
2415            
2416             sub outlines {
2417 0     0 1   my ($self)=@_;
2418            
2419 0   0       $self->{pdf}->{Root}->{Outlines}||=PDF::API3::Compat::API2::Outlines->new($self);
2420            
2421 0           my $obj=$self->{pdf}->{Root}->{Outlines};
2422            
2423 0 0         $self->{pdf}->new_obj($obj) if(!$obj->is_obj($self->{pdf}));
2424 0           $self->{pdf}->out_obj($obj);
2425 0           $self->{pdf}->out_obj($self->{pdf}->{Root});
2426            
2427 0           return($obj);
2428            
2429             }
2430            
2431             #=item $dst $pdf->named_destination $category, $name
2432             #
2433             #Returns a new or existing outlines object.
2434             #
2435             #=cut
2436            
2437             sub named_destination
2438             {
2439 0     0 0   my ($self,$cat,$name,$obj)=@_;
2440 0           my $root=$self->{catalog};
2441            
2442 0   0       $root->{Names}||=PDFDict();
2443 0   0       $root->{Names}->{$cat}||=PDFDict();
2444 0   0       $root->{Names}->{$cat}->{-vals}||={};
2445 0   0       $root->{Names}->{$cat}->{Limits}||=PDFArray();
2446 0   0       $root->{Names}->{$cat}->{Names}||=PDFArray();
2447            
2448 0 0         unless(defined $obj)
2449             {
2450 0           $obj=PDF::API3::Compat::API2::NamedDestination->new_api($self);
2451             }
2452 0           $root->{Names}->{$cat}->{-vals}->{$name}=$obj;
2453            
2454 0           my @names=sort {$a cmp $b} keys %{$root->{Names}->{$cat}->{-vals}};
  0            
  0            
2455            
2456 0           $root->{Names}->{$cat}->{Limits}->{' val'}->[0]=PDFStr($names[0]);
2457 0           $root->{Names}->{$cat}->{Limits}->{' val'}->[1]=PDFStr($names[-1]);
2458            
2459 0           @{$root->{Names}->{$cat}->{Names}->{' val'}}=();
  0            
2460            
2461 0           foreach my $k (@names)
2462             {
2463 0           push @{$root->{Names}->{$cat}->{Names}->{' val'}},
  0            
2464             PDFStr($k),$root->{Names}->{$cat}->{-vals}->{$k};
2465             }
2466            
2467 0           return($obj);
2468             }
2469            
2470             =back
2471            
2472             =head1 RESOURCE METHODS
2473            
2474             =over 4
2475            
2476             =item $pdf->resource $type, $key, $obj, $force
2477            
2478             Adds a resource to the global pdf tree.
2479            
2480             B
2481            
2482             $pdf->resource('Font',$fontkey,$fontobj);
2483             $pdf->resource('XObject',$imagekey,$imageobj);
2484             $pdf->resource('Shading',$shadekey,$shadeobj);
2485             $pdf->resource('ColorSpace',$spacekey,$speceobj);
2486            
2487             B You only have to add the required resources, if
2488             they are NOT handled by the *font*, *image*, *shade* or *space*
2489             methods.
2490            
2491             =cut
2492            
2493             sub resource
2494             {
2495 0     0 1   return(undef);
2496 0           my ($self, $type, $key, $obj, $force) = @_;
2497            
2498 0   0       $self->{pages}->{Resources}||=PDFDict();
2499            
2500 0           my $dict=$self->{pages}->{Resources};
2501 0 0         $dict->realise if(ref($dict)=~/Objind$/);
2502            
2503 0 0         $self->{pdf}->new_obj($dict) unless($dict->is_obj($self->{pdf}));
2504            
2505 0   0       $dict->{$type}=$dict->{$type} || PDFDict();
2506 0 0         $dict->{$type}->realise if(ref($dict->{$type})=~/Objind$/);
2507            
2508 0 0         if(defined($obj))
2509             {
2510 0 0         if($force)
2511             {
2512 0           $dict->{$type}->{$key}=$obj;
2513             }
2514             else
2515             {
2516 0   0       $dict->{$type}->{$key}=$dict->{$type}->{$key} || $obj;
2517             }
2518            
2519 0 0         $self->{pdf}->out_obj($dict)
2520             if($dict->is_obj($self->{pdf}));
2521            
2522 0 0         $self->{pdf}->out_obj($dict->{$type})
2523             if($dict->{$type}->is_obj($self->{pdf}));
2524            
2525 0 0         $self->{pdf}->out_obj($obj)
2526             if($obj->is_obj($self->{pdf}));
2527            
2528 0           $self->{pdf}->out_obj($self->{pages});
2529            
2530 0           return($dict);
2531             }
2532 0   0       return($dict->{$type}->{$key} || undef);
2533             }
2534            
2535             1;
2536            
2537             __END__