File Coverage

blib/lib/PDF/Builder/Page.pm
Criterion Covered Total %
statement 143 194 73.7
branch 39 66 59.0
condition 23 41 56.1
subroutine 29 34 85.2
pod 17 24 70.8
total 251 359 69.9


line stmt bran cond sub pod time code
1             package PDF::Builder::Page;
2              
3 34     34   277 use base 'PDF::Builder::Basic::PDF::Pages';
  34         77  
  34         4640  
4              
5 34     34   244 use strict;
  34         72  
  34         794  
6 34     34   191 use warnings;
  34         77  
  34         2431  
7              
8             our $VERSION = '3.023'; # VERSION
9             our $LAST_UPDATE = '3.023'; # manually update whenever code is changed
10              
11 34     34   264 use POSIX qw(floor);
  34         81  
  34         283  
12 34     34   3134 use Scalar::Util qw(weaken);
  34         78  
  34         1446  
13              
14 34     34   217 use PDF::Builder::Basic::PDF::Utils;
  34         75  
  34         2639  
15 34     34   31943 use PDF::Builder::Content;
  34         120  
  34         1563  
16 34     34   390 use PDF::Builder::Content::Text;
  34         86  
  34         760  
17 34     34   209 use PDF::Builder::Util;
  34         83  
  34         87247  
18              
19             =head1 NAME
20              
21             PDF::Builder::Page - Methods to interact with individual pages
22              
23             =head1 METHODS
24              
25             =over
26              
27             =item $page = PDF::Builder::Page->new($pdf, $parent, $index)
28              
29             Returns a page object (called from $pdf->page()).
30              
31             =cut
32              
33             sub new {
34 141     141 1 393 my ($class, $pdf, $parent, $index) = @_;
35 141         299 my $self = {};
36              
37 141 50       394 $class = ref($class) if ref($class);
38 141         655 $self = $class->SUPER::new($pdf, $parent);
39 141         436 $self->{'Type'} = PDFName('Page');
40 141         696 $self->proc_set(qw( PDF Text ImageB ImageC ImageI ));
41 141         578 delete $self->{'Count'};
42 141         386 delete $self->{'Kids'};
43 141         650 $parent->add_page($self, $index);
44              
45             # copy global UU (if exists) to local, possibly to be overridden
46             # we can access UserUnit (should be not 1.0, if exists) but not userUnit
47 141 50       413 if (defined $self->{'Parent'}->{'UserUnit'}) {
48 0         0 my $UU = $self->{'Parent'}->{'UserUnit'}->{'val'};
49 0         0 $self->{' userUnit'} = $UU;
50             # AND set the local one if global is not 1.0
51             # (some readers don't let a page inherit the global UU)
52 0 0       0 if ($UU != 1.0) {
53 0         0 $self->userunit($UU);
54             }
55             } else {
56             # not setting a global userUnit, so default this one to 1.0
57 141         348 $self->{' userUnit'} = 1;
58             # don't set a local UserUnit for now
59             }
60              
61 141         428 return $self;
62             }
63              
64             #=item $page = PDF::Builder::Page->coerce($pdf, $pdfpage)
65             #
66             #Returns a page object converted from $pdfpage (called from $pdf->open_page()).
67             #
68             #=cut
69              
70             # appears to be unused TBD
71              
72             sub coerce {
73 0     0 0 0 my ($class, $pdf, $page) = @_;
74 0         0 my $self = $page;
75 0         0 bless $self, $class;
76 0         0 $self->{' apipdf'} = $pdf;
77 0         0 weaken $self->{' apipdf'};
78 0         0 return $self;
79             }
80              
81             #=item $page->update()
82             #
83             #Marks a page to be updated (by $pdf->update()).
84             #
85             #=cut
86              
87             # appears to be internal routine
88              
89             sub update {
90 2     2 0 12 my ($self) = @_;
91              
92 2         10 $self->{' apipdf'}->out_obj($self);
93 2         4 return $self;
94             }
95              
96             =item $page->userunit($value)
97              
98             Sets the User Unit for this one page.
99             See L for more information.
100              
101             =cut
102              
103             sub userunit {
104 0     0 1 0 my ($self, $value) = @_;
105              
106 0 0       0 if (float($value) <= 0.0) {
107 0         0 warn "Invalid User Unit value '$value', set to 1.0";
108 0         0 $value = 1.0;
109             }
110              
111             # assume that even if $value is 1.0, it's being called for some reason
112             # (perhaps overriding non-1.0 global setting)
113 0         0 PDF::Builder->verCheckOutput(1.6, "set User Unit");
114 0         0 $self->{' userUnit'} = float($value); # this is local (page) UU
115 0         0 $self->{'UserUnit'} = PDFNum(float($value));
116              
117 0         0 return $self;
118             }
119              
120             sub _bbox {
121 125     125   267 my ($box, $self, @corners) = @_;
122             # $box is the box name (e.g., MediaBox)
123             # $self points to the page object
124             # at least one element in @corners if setting. get if no elements.
125              
126             # if 1 or 3 elements in @corners, and [0] contains a letter, it's a name
127 125         167 my $isName = 0;
128 125 100 100     495 if (scalar @corners && $corners[0] =~ m/[a-z]/i) { $isName = 1; }
  29         48  
129              
130 125 100       295 if (scalar @corners == 0) {
    50          
131             # is a query ('get')
132             # if previously set for this page, just return array
133             # if not set, check parent (PDF), then up chain as far as MediaBox
134 78 100       154 if (defined $self->{$box}) {
135 53         143 return map { $_->val() } $self->{$box}->elements();
  212         372  
136             } else {
137 25         41 my $pdf = $self->{' api'};
138 25 100       53 if (defined $pdf->{'pages'}->{$box}) {
139             # parent (global) box is defined
140 17         51 return map { $_->val() } $pdf->{'pages'}->{$box}->elements();
  68         129  
141             } else {
142             # go up the chain until find defined global
143 8 100 100     46 if ($box eq 'ArtBox' || $box eq 'TrimBox' || $box eq 'BleedBox') {
      100        
144 6         9 $box = 'CropBox';
145             }
146 8 50 33     39 if ($box eq 'CropBox' && !defined $pdf->{'pages'}->{'CropBox'}) {
147 8         14 $box = 'MediaBox';
148             }
149 8 50 33     31 if ($box ne 'CropBox' && $box ne 'MediaBox') {
150             # invalid box name. silent error: just return Media Box
151 0         0 $box = 'MediaBox';
152             }
153 8         28 return map { $_->val() } $pdf->{'pages'}->{$box}->elements();
  32         64  
154             }
155             }
156            
157             } elsif (scalar @corners == 3) {
158             # have a name and one option (-orient)
159 0         0 my ($name, %opts) = @corners;
160 0         0 @corners = page_size(($name)); # now 4 numeric values
161 0 0       0 if (defined $opts{'-orient'}) {
162 0 0       0 if ($opts{'-orient'} =~ m/^l/i) { # 'landscape' or just 'l'
163             # 0 0 W H -> 0 0 H W
164 0         0 my $temp;
165 0         0 $temp = $corners[2]; $corners[2] = $corners[3]; $corners[3] = $temp;
  0         0  
  0         0  
166             }
167             }
168             } else {
169             # name without [-orient] option, or numeric coordinates given
170 47         155 @corners = page_size(@corners);
171             }
172              
173             # scale down size if User Unit given (e.g., Letter => 0 0 8.5 11)
174             # we have a global userUnit, and possibly a page userUnit overriding it
175 47 100       106 if ($isName) {
176 29         55 my $UU = $self->{' userUnit'};
177 29 50       66 if ($UU != 1.0) {
178 0         0 for (my $i=0; $i<4; $i++) {
179 0         0 $corners[$i] /= $UU;
180             }
181             }
182             }
183              
184 47         87 $self->{$box} = PDFArray( map { PDFNum(float($_)) } @corners );
  188         369  
185             # return 4 element array of box corners
186 47         126 return @corners;
187             }
188              
189             =item $page->mediabox($alias)
190              
191             =item $page->mediabox($alias, -orient => 'orientation')
192              
193             =item $page->mediabox($w,$h)
194              
195             =item $page->mediabox($llx,$lly, $urx,$ury)
196              
197             =item ($llx,$lly, $urx,$ury) = $page->mediabox()
198              
199             Sets or gets the Media Box for this one page.
200             See L for more information.
201             The method always returns the current bounds (after any set operation).
202              
203             =cut
204              
205             sub mediabox {
206 73     73 1 53425 return _bbox('MediaBox', @_);
207             }
208              
209             =item ($llx,$lly, $urx,$ury) = $page->get_mediabox()
210              
211             Gets the Media Box corner coordinates based on best estimates or the default.
212             These are in the order given in a mediabox call (4 coordinates).
213              
214             This method is B, and will likely be removed in the future. Use
215             the global (C<$pdf>) or page (C<$page>) mediabox() call with no parameters
216             instead.
217              
218             =cut
219              
220             sub get_mediabox {
221 34     34 1 130 my $self = shift();
222 34         55 return $self->mediabox();
223             }
224              
225             =item $page->cropbox($alias)
226              
227             =item $page->cropbox($alias, -orient => 'orientation')
228              
229             =item $page->cropbox($w,$h)
230              
231             =item $page->cropbox($llx,$lly, $urx,$ury)
232              
233             =item ($llx,$lly, $urx,$ury) = $page->cropbox()
234              
235             Sets or gets the Crop Box for this one page.
236             See L for more information.
237             The method always returns the current bounds (after any set operation).
238              
239             =cut
240              
241             sub cropbox {
242 13     13 1 3789 return _bbox('CropBox', @_);
243             }
244              
245             =item ($llx,$lly, $urx,$ury) = $page->get_cropbox()
246              
247             Gets the Crop Box based on best estimates or the default.
248              
249             This method is B, and will likely be removed in the future. Use
250             the global (C<$pdf>) or page (C<$page>) cropbox() call with no parameters
251             instead.
252              
253             =cut
254              
255             sub get_cropbox {
256 6     6 1 40 my $self = shift();
257 6         16 return $self->cropbox();
258             }
259              
260             =item $page->bleedbox($alias)
261              
262             =item $page->bleedbox($alias, -orient => 'orientation')
263              
264             =item $page->bleedbox($w,$h)
265              
266             =item $page->bleedbox($llx,$lly, $urx,$ury)
267              
268             =item ($llx,$lly, $urx,$ury) = $page->bleedbox()
269              
270             Sets or gets or gets the Bleed Box for this one page.
271             See L for more information.
272             The method always returns the current bounds (after any set operation).
273              
274             =cut
275              
276             sub bleedbox {
277 13     13 1 3885 return _bbox('BleedBox', @_);
278             }
279              
280             =item ($llx,$lly, $urx,$ury) = $page->get_bleedbox()
281              
282             Gets the Bleed Box based on best estimates or the default.
283              
284             This method is B, and will likely be removed in the future. Use
285             the global (C<$pdf>) or page (C<$page>) bleedbox() call with no parameters
286             instead.
287              
288             =cut
289              
290             sub get_bleedbox {
291 6     6 1 37 my $self = shift();
292 6         17 return $self->bleedbox();
293             }
294              
295             =item $page->trimbox($alias)
296              
297             =item $page->trimbox($alias, -orient => 'orientation')
298              
299             =item $page->trimbox($w,$h)
300              
301             =item $page->trimbox($llx,$lly, $urx,$ury)
302              
303             =item ($llx,$lly, $urx,$ury) = $page->trimbox()
304              
305             Sets or gets the Trim Box for this one page.
306             See L for more information.
307             The method always returns the current bounds (after any set operation).
308              
309             =cut
310              
311             sub trimbox {
312 13     13 1 3920 return _bbox('TrimBox', @_);
313             }
314              
315             =item ($llx,$lly, $urx,$ury) = $page->get_trimbox()
316              
317             Gets the Trim Box based on best estimates or the default.
318              
319             This method is B, and will likely be removed in the future. Use
320             the global (C<$pdf>) or page (C<$page>) trimbox() call with no parameters
321             instead.
322              
323             =cut
324              
325             sub get_trimbox {
326 6     6 1 39 my $self = shift();
327 6         17 return $self->trimbox();
328             }
329              
330             =item $page->artbox($alias)
331              
332             =item $page->artbox($alias, -orient => 'orientation')
333              
334             =item $page->artbox($w,$h)
335              
336             =item $page->artbox($llx,$lly, $urx,$ury)
337              
338             =item ($llx,$lly, $urx,$ury) = $page->artbox()
339              
340             Sets or gets the Art Box for this one page.
341             See L for more information.
342             The method always returns the current bounds (after any set operation).
343              
344             =cut
345              
346             sub artbox {
347 13     13 1 3770 return _bbox('ArtBox', @_);
348             }
349              
350             =item ($llx,$lly, $urx,$ury) = $page->get_artbox()
351              
352             Gets the Art Box based on best estimates or the default.
353              
354             This method is B, and will likely be removed in the future. Use
355             the global (C<$pdf>) or page (C<$page>) artbox() call with no parameters
356             instead.
357              
358             =cut
359              
360             sub get_artbox {
361 6     6 1 39 my $self = shift();
362 6         16 return $self->artbox();
363             }
364              
365             =item $page->rotate($deg)
366              
367             Rotates the page by the given degrees, which must be a multiple of 90.
368             An angle that is not a multiple of 90 will be rounded to the nearest 90
369             degrees, with a message.
370             Note that the rotation angle is I for a positive amount!
371             E.g., a rotation of +90 (or -270) will have the bottom edge of the paper at
372             the left of the screen.
373              
374             (This allows you to auto-rotate to landscape without changing the mediabox!)
375              
376             Do not confuse this C call with the I rotation
377             (Content.pm) C, which permits any angle, is of opposite direction,
378             and does not shift the origin!
379              
380             =cut
381              
382             sub rotate {
383 0     0 1 0 my ($self, $degrees) = @_;
384              
385             # Ignore rotation of 360 or more (in either direction)
386 0         0 $degrees = $degrees % 360; # range [0, 360)
387 0 0       0 if ($degrees % 90) {
388 0         0 my $deg = int(($degrees + 45)/90)*90;
389 0         0 warn "page rotate($degrees) invalid, not multiple of 90 degrees.\nChanged to $deg";
390 0         0 $degrees = $deg;
391             }
392              
393 0         0 $self->{'Rotate'} = PDFNum($degrees);
394              
395 0         0 return $self;
396             }
397              
398             sub fixcontents {
399 118     118 0 242 my ($self) = @_;
400              
401 118   66     574 $self->{'Contents'} = $self->{'Contents'} || PDFArray();
402 118 50       583 if (ref($self->{'Contents'}) =~ /Objind$/) {
403 0         0 $self->{'Contents'}->realise();
404             }
405 118 50       721 if (ref($self->{'Contents'}) !~ /Array$/) {
406 0         0 $self->{'Contents'} = PDFArray($self->{'Contents'});
407             }
408 118         236 return;
409             }
410              
411             sub content {
412 111     111 0 262 my ($self, $obj, $dir) = @_;
413              
414 111 50 33     396 if (defined($dir) && $dir > 0) {
415 0         0 $self->precontent($obj);
416             } else {
417 111         326 $self->addcontent($obj);
418             }
419 111 50       484 $self->{' apipdf'}->new_obj($obj) unless $obj->is_obj($self->{' apipdf'});
420 111         262 $obj->{' apipdf'} = $self->{' apipdf'};
421 111         455 $obj->{' api'} = $self->{' api'};
422 111         248 $obj->{' apipage'} = $self;
423              
424 111         410 weaken $obj->{' apipdf'};
425 111         294 weaken $obj->{' api'};
426 111         318 weaken $obj->{' apipage'};
427              
428 111         212 return $obj;
429             }
430              
431             sub addcontent {
432 111     111 0 302 my ($self, @objs) = @_;
433              
434 111         379 $self->fixcontents();
435 111         382 $self->{'Contents'}->add_elements(@objs);
436 111         215 return;
437             }
438              
439             sub precontent {
440 0     0 0 0 my ($self, @objs) = @_;
441              
442 0         0 $self->fixcontents();
443 0         0 unshift(@{$self->{'Contents'}->val()}, @objs);
  0         0  
444 0         0 return;
445             }
446              
447             =item $gfx = $page->gfx($prepend)
448              
449             =item $gfx = $page->gfx()
450              
451             Returns a graphics content object.
452             If $prepend is I, the content will be prepended to the page description.
453             Otherwise, it will be appended.
454              
455             You may have more than one I object. They and I objects will be
456             output as objects and streams in the order defined, with all actions pertaining
457             to this I object appearing in one stream. However, note that graphics
458             and text objects are not fully independent of each other: the exit state
459             (linewidth, strokecolor, etc.) of one object is the entry state of the next
460             object in line to be output, and so on.
461              
462             If you intermix multiple I and I objects on
463             a page, the results may be confusing. Say you have $gfx1, $text1, $gfx2, and
464             $text2 on your page (I). PDF::Builder will output all the
465             $gfx1->I calls in one stream, then all the $text1->I calls in
466             the next stream, and likewise for $gfx2 usage and finally $text2.
467              
468             Then it's PDF's turn to confuse you. PDF will process the entire $gfx1 object
469             stream, accumulating the graphics state to the end of the stream, and using
470             that as the entry state into $text1. In a similar manner, $gfx2 and $text2 are
471             read, processed, and rendered. Thus, a change in, say, the dash pattern in the
472             middle of $gfx1, I you have output some $gfx2, $text1, and $text2
473             material, may suddenly show up at the beginning of $text1 (and continue through
474             $gfx2 and $text2)!
475              
476             It is possible to use multiple graphics objects, to avoid having to change
477             settings constantly, but you may want to consider resetting all your settings
478             at the first call to each object, so that you are starting from a known base.
479             This may most easily be done by using $I->restore() and ->save() just
480             after creating $I:
481              
482             =over
483              
484             $text1 = $page->text();
485             $text1->save();
486             $grfx1 = $page->gfx();
487             $grfx1->restore();
488             $grfx1->save();
489             $text2 = $page->text();
490             $text2->restore();
491             $text2->save();
492             $grfx2 = $page->gfx();
493             $grfx1->restore();
494              
495             =back
496              
497             =cut
498              
499             sub gfx {
500 91     91 1 652 my ($self, $prepend) = @_;
501              
502 91         634 my $gfx = PDF::Builder::Content->new();
503 91         360 $self->content($gfx, $prepend);
504             $gfx->compressFlate() if ($self->{' api'}->{'forcecompress'} eq 'flate' ||
505 91 100 66     642 $self->{' api'}->{'forcecompress'} =~ m/^[1-9]\d*$/);
506              
507 91         386 return $gfx;
508             }
509              
510             =item $txt = $page->text($prepend)
511              
512             =item $txt = $page->text()
513              
514             Returns a text content object.
515             If $prepend is I, the content will be prepended to the page description.
516             Otherwise, it will be appended.
517              
518             Please see the discussion above in C regarding multiple graphics and
519             text objects on one page, how they are grouped into PDF objects and streams,
520             and the rendering consequences of running through one entire object at a time,
521             before moving on to the next.
522              
523             The I object has many settings and attributes of its own, but shares many
524             with graphics (I), such as strokecolor, fillcolor, linewidth, linedash,
525             and the like. Thus there is some overlap in attributes, and graphics and text
526             calls can affect each other.
527              
528             =cut
529              
530             sub text {
531 20     20 1 1004 my ($self, $prepend) = @_;
532              
533 20         199 my $text = PDF::Builder::Content::Text->new();
534 20         128 $self->content($text, $prepend);
535             $text->compressFlate() if ($self->{' api'}->{'forcecompress'} eq 'flate' ||
536 20 100 66     201 $self->{' api'}->{'forcecompress'} =~ m/^[1-9]\d*$/);
537              
538 20         145 return $text;
539             }
540              
541             =item $ant = $page->annotation()
542              
543             Returns a new annotation object.
544              
545             =cut
546              
547             sub annotation {
548 2     2 1 18 my $self = shift;
549              
550 2 100 33     14 unless (exists $self->{'Annots'}) {
551 1         21 $self->{'Annots'} = PDFArray();
552 1         6 $self->update();
553             } elsif (ref($self->{'Annots'}) =~ /Objind/) {
554             $self->{'Annots'}->realise();
555             }
556              
557 2         1161 require PDF::Builder::Annotation;
558 2         20 my $ant = PDF::Builder::Annotation->new();
559 2         16 $self->{'Annots'}->add_elements($ant);
560 2         18 $self->{' apipdf'}->new_obj($ant);
561 2         6 $ant->{' apipdf'} = $self->{' apipdf'};
562 2         7 $ant->{' apipage'} = $self;
563 2         14 weaken $ant->{' apipdf'};
564 2         8 weaken $ant->{' apipage'};
565              
566 2 100       11 if ($self->{'Annots'}->is_obj($self->{' apipdf'})) {
567 1         5 $self->{' apipdf'}->out_obj($self->{'Annots'});
568             }
569              
570 2         21 return $ant;
571             }
572              
573             =item $page->resource($type, $key, $obj)
574              
575             Adds a resource to the page-inheritance tree.
576              
577             B
578              
579             $co->resource('Font', $fontkey, $fontobj);
580             $co->resource('XObject', $imagekey, $imageobj);
581             $co->resource('Shading', $shadekey, $shadeobj);
582             $co->resource('ColorSpace', $spacekey, $speceobj);
583              
584             B You only have to add the required resources if
585             they are NOT handled by the *font*, *image*, *shade* or *space*
586             methods.
587              
588             =cut
589              
590             sub resource {
591 30     30 1 130 my ($self, $type, $key, $obj, $force) = @_;
592              
593 30         185 my $dict = $self->find_prop('Resources');
594              
595 30   0     162 $dict = $dict || $self->{'Resources'} || PDFDict();
596              
597 30 50       210 $dict->realise() if ref($dict) =~ /Objind$/;
598              
599 30   66     211 $dict->{$type} = $dict->{$type} || PDFDict();
600 30 50       152 $dict->{$type}->realise() if ref($dict->{$type}) =~ /Objind$/;
601              
602 30 100       126 unless (defined $obj) {
603 2   50     16 return $dict->{$type}->{$key} || undef;
604             } else {
605 28 50       95 if ($force) {
606 0         0 $dict->{$type}->{$key} = $obj;
607             } else {
608 28   33     188 $dict->{$type}->{$key} = $dict->{$type}->{$key} || $obj;
609             }
610              
611 28 50       149 $self->{' apipdf'}->out_obj($dict) if $dict->is_obj($self->{' apipdf'});
612 28 50       138 $self->{' apipdf'}->out_obj($dict->{$type}) if $dict->{$type}->is_obj($self->{' apipdf'});
613 28 100       132 $self->{' apipdf'}->out_obj($obj) if $obj->is_obj($self->{' apipdf'});
614 28         119 $self->{' apipdf'}->out_obj($self);
615              
616 28         99 return $dict;
617             }
618             }
619              
620             sub ship_out {
621 0     0 0   my ($self, $pdf) = @_;
622              
623 0           $pdf->ship_out($self);
624 0 0         if (defined $self->{'Contents'}) {
625 0           $pdf->ship_out($self->{'Contents'}->elements());
626             }
627 0           return $self;
628             }
629              
630             #sub outobjdeep {
631             # my ($self, @opts) = @_;
632             #
633             # foreach my $k (qw/ api apipdf /) {
634             # $self->{" $k"} = undef;
635             # delete($self->{" $k"});
636             # }
637             # return $self->SUPER::outobjdeep(@opts);
638             #}
639              
640             =back
641              
642             =cut
643              
644             1;