File Coverage

blib/lib/PDF/API3/Compat/API2/Page.pm
Criterion Covered Total %
statement 38 233 16.3
branch 0 68 0.0
condition 0 20 0.0
subroutine 13 37 35.1
pod 19 24 79.1
total 70 382 18.3


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: Page.pm,v 2.1 2007/05/08 18:32:09 areibens Exp $
31             #
32             #=======================================================================
33             package PDF::API3::Compat::API2::Page;
34            
35             BEGIN {
36            
37 1     1   6 use strict;
  1         2  
  1         46  
38 1     1   6 use vars qw(@ISA %pgsz $VERSION);
  1         2  
  1         79  
39            
40 1     1   22 @ISA = qw(PDF::API3::Compat::API2::Basic::PDF::Pages);
41 1     1   8 use PDF::API3::Compat::API2::Basic::PDF::Pages;
  1         2  
  1         23  
42 1     1   6 use PDF::API3::Compat::API2::Basic::PDF::Utils;
  1         3  
  1         129  
43 1     1   6 use PDF::API3::Compat::API2::Util;
  1         1  
  1         277  
44            
45 1     1   879 use PDF::API3::Compat::API2::Annotation;
  1         3  
  1         55  
46            
47 1     1   939 use PDF::API3::Compat::API2::Content;
  1         4  
  1         51  
48 1     1   746 use PDF::API3::Compat::API2::Content::Text;
  1         3  
  1         36  
49            
50 1     1   5 use PDF::API3::Compat::API2::Util;
  1         2  
  1         155  
51            
52 1     1   7 use POSIX qw(floor ceil);
  1         1  
  1         10  
53 1     1   70 use Math::Trig;
  1         2  
  1         363  
54            
55 1         33 ( $VERSION ) = sprintf '%i.%03i', split(/\./,('$Revision: 2.1 $' =~ /Revision: (\S+)\s/)[0]); # $Date: 2007/05/08 18:32:09 $
56            
57             }
58            
59 1     1   6 no warnings qw[ deprecated recursion uninitialized ];
  1         2  
  1         3062  
60            
61             =head1 $page = PDF::API3::Compat::API2::Page->new $pdf, $parent, $index
62            
63             Returns a page object (called from $pdf->page).
64            
65             =cut
66            
67             sub new {
68 0     0 1   my ($class, $pdf, $parent, $index) = @_;
69 0           my ($self) = {};
70            
71 0 0         $class = ref $class if ref $class;
72 0           $self = $class->SUPER::new($pdf, $parent);
73 0           $self->{'Type'} = PDFName('Page');
74 0           $self->proc_set(qw( PDF Text ImageB ImageC ImageI ));
75 0           delete $self->{'Count'};
76 0           delete $self->{'Kids'};
77 0           $parent->add_page($self, $index);
78 0           $self;
79             }
80            
81             =item $page = PDF::API3::Compat::API2::Page->coerce $pdf, $pdfpage
82            
83             Returns a page object converted from $pdfpage (called from $pdf->openpage).
84            
85             =cut
86            
87             sub coerce {
88 0     0 1   my ($class, $pdf, $page) = @_;
89 0           my $self = $page;
90 0           bless($self,$class);
91 0           $self->{' apipdf'}=$pdf;
92 0           return($self);
93             }
94            
95             =item $page->update
96            
97             Marks a page to be updated (by $pdf->update).
98            
99             =cut
100            
101             sub update {
102 0     0 1   my ($self) = @_;
103 0           $self->{' apipdf'}->out_obj($self);
104 0           $self;
105             }
106            
107             =item $page->mediabox $w, $h
108            
109             =item $page->mediabox $llx, $lly, $urx, $ury
110            
111             =item $page->mediabox $alias
112            
113             Sets the mediabox. This method supports the following aliases:
114             '4A', '2A', 'A0', 'A1', 'A2', 'A3', 'A4', 'A5', 'A6',
115             '4B', '2B', 'B0', 'B1', 'B2', 'B3', 'B4', 'B5', 'B6',
116             'LETTER', 'BROADSHEET', 'LEDGER', 'TABLOID', 'LEGAL',
117             'EXECUTIVE', and '36X36'.
118            
119             =cut
120            
121             sub mediabox {
122 0     0 1   my ($self,$x1,$y1,$x2,$y2) = @_;
123 0 0         if(defined $x2) {
    0          
124 0           $self->{'MediaBox'}=PDFArray(
125 0           map { PDFNum(float($_)) } ($x1,$y1,$x2,$y2)
126             );
127             } elsif(defined $y1) {
128 0           $self->{'MediaBox'}=PDFArray(
129 0           map { PDFNum(float($_)) } (0,0,$x1,$y1)
130             );
131             } else {
132 0           $self->{'MediaBox'}=PDFArray(
133 0           (map { PDFNum(float($_)) } page_size($x1))
134             );
135             }
136 0           return($self);
137             }
138            
139             =item ($llx, $lly, $urx, $ury) = $page->get_mediabox
140            
141             Gets the mediabox based one best estimates or the default.
142            
143             =cut
144            
145             sub get_mediabox {
146 0     0 1   my ($self) = @_;
147 0           my $media = [ 0, 0, 612, 792 ];
148 0           foreach my $mediatype (
149             qw( MediaBox CropBox BleedBox TrimBox ArtBox )
150             ) {
151 0           my $mediaobj = undef;
152 0 0         if($mediaobj = $self->find_prop($mediatype)) {
153 0           $media = [ map{ $_->val } $mediaobj->elementsof ];
  0            
154 0           last;
155             }
156             }
157            
158 0           return(@{$media});
  0            
159             }
160            
161             =item $page->cropbox $w, $h
162            
163             =item $page->cropbox $llx, $lly, $urx, $ury
164            
165             =item $page->cropbox $alias
166            
167             Sets the cropbox. This method supports the same aliases as mediabox.
168            
169             =cut
170            
171             sub cropbox {
172 0     0 1   my ($self,$x1,$y1,$x2,$y2) = @_;
173 0 0         if(defined $x2) {
    0          
174 0           $self->{'CropBox'}=PDFArray(
175 0           map { PDFNum(float($_)) } ($x1,$y1,$x2,$y2)
176             );
177             } elsif(defined $y1) {
178 0           $self->{'CropBox'}=PDFArray(
179 0           map { PDFNum(float($_)) } (0,0,$x1,$y1)
180             );
181             } else {
182 0           $self->{'CropBox'}=PDFArray(
183 0           (map { PDFNum(float($_)) } page_size($x1))
184             );
185             }
186 0           $self;
187             }
188            
189             =item ($llx, $lly, $urx, $ury) = $page->get_cropbox
190            
191             Gets the cropbox based one best estimates or the default.
192            
193             =cut
194            
195             sub get_cropbox
196             {
197 0     0 1   my ($self) = @_;
198 0           my $media = [ 0, 0, 612, 792 ];
199 0           foreach my $mediatype (qw[CropBox BleedBox TrimBox ArtBox MediaBox])
200             {
201 0           my $mediaobj = undef;
202 0 0         if($mediaobj = $self->find_prop($mediatype))
203             {
204 0           $media = [ map{ $_->val } $mediaobj->elementsof ];
  0            
205 0           last;
206             }
207             }
208            
209 0           return(@{$media});
  0            
210             }
211            
212             =item $page->bleedbox $w, $h
213            
214             =item $page->bleedbox $llx, $lly, $urx, $ury
215            
216             =item $page->bleedbox $alias
217            
218             Sets the bleedbox. This method supports the same aliases as mediabox.
219            
220             =cut
221            
222             sub bleedbox {
223 0     0 1   my ($self,$x1,$y1,$x2,$y2) = @_;
224 0 0         if(defined $x2) {
    0          
225 0           $self->{'BleedBox'}=PDFArray(
226 0           map { PDFNum(float($_)) } ($x1,$y1,$x2,$y2)
227             );
228             } elsif(defined $y1) {
229 0           $self->{'BleedBox'}=PDFArray(
230 0           map { PDFNum(float($_)) } (0,0,$x1,$y1)
231             );
232             } else {
233 0           $self->{'BleedBox'}=PDFArray(
234 0           (map { PDFNum(float($_)) } page_size($x1))
235             );
236             }
237 0           $self;
238             }
239            
240             =item ($llx, $lly, $urx, $ury) = $page->get_bleedbox
241            
242             Gets the bleedbox based one best estimates or the default.
243            
244             =cut
245            
246             sub get_bleedbox
247             {
248 0     0 1   my ($self) = @_;
249 0           my $media = [ 0, 0, 612, 792 ];
250 0           foreach my $mediatype (qw[BleedBox TrimBox ArtBox MediaBox CropBox])
251             {
252 0           my $mediaobj = undef;
253 0 0         if($mediaobj = $self->find_prop($mediatype))
254             {
255 0           $media = [ map{ $_->val } $mediaobj->elementsof ];
  0            
256 0           last;
257             }
258             }
259            
260 0           return(@{$media});
  0            
261             }
262            
263             =item $page->trimbox $w, $h
264            
265             =item $page->trimbox $llx, $lly, $urx, $ury
266            
267             Sets the trimbox. This method supports the same aliases as mediabox.
268            
269             =cut
270            
271             sub trimbox {
272 0     0 1   my ($self,$x1,$y1,$x2,$y2) = @_;
273 0 0         if(defined $x2) {
    0          
274 0           $self->{'TrimBox'}=PDFArray(
275 0           map { PDFNum(float($_)) } ($x1,$y1,$x2,$y2)
276             );
277             } elsif(defined $y1) {
278 0           $self->{'TrimBox'}=PDFArray(
279 0           map { PDFNum(float($_)) } (0,0,$x1,$y1)
280             );
281             } else {
282 0           $self->{'TrimBox'}=PDFArray(
283 0           (map { PDFNum(float($_)) } page_size($x1))
284             );
285             }
286 0           $self;
287             }
288            
289             =item ($llx, $lly, $urx, $ury) = $page->get_trimbox
290            
291             Gets the trimbox based one best estimates or the default.
292            
293             =cut
294            
295             sub get_trimbox
296             {
297 0     0 1   my ($self) = @_;
298 0           my $media = [ 0, 0, 612, 792 ];
299 0           foreach my $mediatype (qw[TrimBox ArtBox MediaBox CropBox BleedBox])
300             {
301 0           my $mediaobj = undef;
302 0 0         if($mediaobj = $self->find_prop($mediatype))
303             {
304 0           $media = [ map{ $_->val } $mediaobj->elementsof ];
  0            
305 0           last;
306             }
307             }
308            
309 0           return(@{$media});
  0            
310             }
311            
312             =item $page->artbox $w, $h
313            
314             =item $page->artbox $llx, $lly, $urx, $ury
315            
316             =item $page->artbox $alias
317            
318             Sets the artbox. This method supports the same aliases as mediabox.
319            
320             =cut
321            
322             sub artbox {
323 0     0 1   my ($self,$x1,$y1,$x2,$y2) = @_;
324 0 0         if(defined $x2) {
    0          
325 0           $self->{'ArtBox'}=PDFArray(
326 0           map { PDFNum(float($_)) } ($x1,$y1,$x2,$y2)
327             );
328             } elsif(defined $y1) {
329 0           $self->{'ArtBox'}=PDFArray(
330 0           map { PDFNum(float($_)) } (0,0,$x1,$y1)
331             );
332             } else {
333 0           $self->{'ArtBox'}=PDFArray(
334 0           (map { PDFNum(float($_)) } page_size($x1))
335             );
336             }
337 0           $self;
338             }
339            
340             =item ($llx, $lly, $urx, $ury) = $page->get_artbox
341            
342             Gets the artbox based one best estimates or the default.
343            
344             =cut
345            
346             sub get_artbox
347             {
348 0     0 1   my ($self) = @_;
349 0           my $media = [ 0, 0, 612, 792 ];
350 0           foreach my $mediatype (qw[ArtBox TrimBox BleedBox CropBox MediaBox])
351             {
352 0           my $mediaobj = undef;
353 0 0         if($mediaobj = $self->find_prop($mediatype))
354             {
355 0           $media = [ map{ $_->val } $mediaobj->elementsof ];
  0            
356 0           last;
357             }
358             }
359            
360 0           return(@{$media});
  0            
361             }
362            
363             =item $page->rotate $deg
364            
365             Rotates the page by the given degrees, which must be a multiple of 90.
366            
367             (This allows you to auto-rotate to landscape without changing the mediabox!)
368            
369             =cut
370            
371             sub rotate {
372 0     0 1   my ($self,$deg) = @_;
373 0           $deg=floor($deg/90);
374 0           while($deg>4) {
375 0           $deg-=4;
376             }
377 0           while($deg<0) {
378 0           $deg+=4;
379             }
380 0 0         if($deg==0) {
381 0           delete $self->{Rotate};
382             } else {
383 0           $self->{Rotate}=PDFNum($deg*90);
384             }
385 0           return($self);
386             }
387            
388             =item $gfx = $page->gfx $prepend
389            
390             Returns a graphics content object. If $prepend is true the content
391             will be prepended to the page description.
392            
393             =cut
394            
395             sub fixcontents {
396 0     0 0   my ($self) = @_;
397 0   0       $self->{'Contents'} = $self->{'Contents'} || PDFArray();
398 0 0         if(ref($self->{'Contents'})=~/Objind$/) {
399 0           $self->{'Contents'}->realise;
400             }
401 0 0         if(ref($self->{'Contents'})!~/Array$/) {
402 0           $self->{'Contents'} = PDFArray($self->{'Contents'});
403             }
404             }
405            
406             sub content {
407 0     0 0   my ($self,$obj,$dir) = @_;
408 0 0 0       if(defined($dir) && $dir>0) {
409 0           $self->precontent($obj);
410             } else {
411 0           $self->addcontent($obj);
412             }
413 0 0         $self->{' apipdf'}->new_obj($obj) unless($obj->is_obj($self->{' apipdf'}));
414 0           $obj->{' apipdf'}=$self->{' apipdf'};
415 0           $obj->{' api'}=$self->{' api'};
416 0           $obj->{' apipage'}=$self;
417 0           return($obj);
418             }
419            
420             sub addcontent {
421 0     0 0   my ($self,@objs) = @_;
422 0           $self->fixcontents;
423 0           $self->{'Contents'}->add_elements(@objs);
424             }
425             sub precontent {
426 0     0 0   my ($self,@objs) = @_;
427 0           $self->fixcontents;
428 0           unshift(@{$self->{'Contents'}->val},@objs);
  0            
429             }
430            
431             sub gfx {
432 0     0 1   my ($self,$dir) = @_;
433 0           my $gfx=PDF::API3::Compat::API2::Content->new();
434 0           $self->content($gfx,$dir);
435 0 0         $gfx->compressFlate() if($self->{' api'}->{forcecompress});
436 0           return($gfx);
437             }
438            
439             =item $txt = $page->text $prepend
440            
441             Returns a text content object. If $prepend is true the content
442             will be prepended to the page description.
443            
444             =cut
445            
446             sub text {
447 0     0 1   my ($self,$dir) = @_;
448 0           my $text=PDF::API3::Compat::API2::Content::Text->new();
449 0           $self->content($text,$dir);
450 0 0         $text->compressFlate() if($self->{' api'}->{forcecompress});
451 0           return($text);
452             }
453            
454             =item $ant = $page->annotation
455            
456             Returns a new annotation object.
457            
458             =cut
459            
460             sub annotation {
461 0     0 1   my ($self, $type, $key, $obj) = @_;
462            
463 0   0       $self->{'Annots'}||=PDFArray();
464 0 0         $self->{'Annots'}->realise if(ref($self->{'Annots'})=~/Objind/);
465 0 0         if($self->{'Annots'}->is_obj($self->{' apipdf'}))
466             {
467 0           $self->{'Annots'}->update();
468             }
469             else
470             {
471 0           $self->update();
472             }
473            
474 0           my $ant=PDF::API3::Compat::API2::Annotation->new;
475 0           $self->{'Annots'}->add_elements($ant);
476 0           $self->{' apipdf'}->new_obj($ant);
477 0           $ant->{' apipdf'}=$self->{' apipdf'};
478 0           $ant->{' apipage'}=$self;
479            
480 0 0         if($self->{'Annots'}->is_obj($self->{' apipdf'}))
481             {
482 0           $self->{' apipdf'}->out_obj($self->{'Annots'});
483             }
484            
485 0           return($ant);
486             }
487            
488             =item $page->resource $type, $key, $obj
489            
490             Adds a resource to the page-inheritance tree.
491            
492             B
493            
494             $co->resource('Font',$fontkey,$fontobj);
495             $co->resource('XObject',$imagekey,$imageobj);
496             $co->resource('Shading',$shadekey,$shadeobj);
497             $co->resource('ColorSpace',$spacekey,$speceobj);
498            
499             B You only have to add the required resources, if
500             they are NOT handled by the *font*, *image*, *shade* or *space*
501             methods.
502            
503             =cut
504            
505             sub resource {
506 0     0 1   my ($self, $type, $key, $obj, $force) = @_;
507 0           my ($dict) = $self->find_prop('Resources');
508            
509 0   0       $dict = $dict || $self->{Resources} || PDFDict();
510            
511 0 0         $dict->realise if(ref($dict)=~/Objind$/);
512            
513 0   0       $dict->{$type} = $dict->{$type} || PDFDict();
514 0 0         $dict->{$type}->realise if(ref($dict->{$type})=~/Objind$/);
515            
516 0 0         unless(defined $obj) {
517 0   0       return($dict->{$type}->{$key} || undef);
518             } else {
519 0 0         if($force) {
520 0           $dict->{$type}->{$key} = $obj;
521             } else {
522 0   0       $dict->{$type}->{$key} = $dict->{$type}->{$key} || $obj;
523             }
524            
525 0 0         $self->{' apipdf'}->out_obj($dict) if($dict->is_obj($self->{' apipdf'}));
526 0 0         $self->{' apipdf'}->out_obj($dict->{$type}) if($dict->{$type}->is_obj($self->{' apipdf'}));
527 0 0         $self->{' apipdf'}->out_obj($obj) if($obj->is_obj($self->{' apipdf'}));
528 0           $self->{' apipdf'}->out_obj($self);
529            
530 0           return($dict);
531             }
532             }
533            
534             sub ship_out
535             {
536 0     0 0   my ($self, $pdf) = @_;
537            
538 0           $pdf->ship_out($self);
539 0 0         if (defined $self->{'Contents'})
540 0           { $pdf->ship_out($self->{'Contents'}->elementsof); }
541 0           $self;
542             }
543            
544             sub outobjdeep {
545 0     0 1   my ($self, @opts) = @_;
546 0           foreach my $k (qw/ api apipdf /) {
547 0           $self->{" $k"}=undef;
548 0           delete($self->{" $k"});
549             }
550 0           $self->SUPER::outobjdeep(@opts);
551             }
552            
553             1;
554            
555             __END__