File Coverage

blib/lib/PDF/Builder/Page.pm
Criterion Covered Total %
statement 204 307 66.4
branch 63 146 43.1
condition 29 82 35.3
subroutine 35 42 83.3
pod 20 29 68.9
total 351 606 57.9


line stmt bran cond sub pod time code
1             package PDF::Builder::Page;
2              
3 38     38   346 use base 'PDF::Builder::Basic::PDF::Pages';
  38         83  
  38         4239  
4              
5 38     38   260 use strict;
  38         88  
  38         850  
6 38     38   182 use warnings;
  38         70  
  38         1923  
7              
8             our $VERSION = '3.025'; # VERSION
9             our $LAST_UPDATE = '3.025'; # manually update whenever code is changed
10              
11 38     38   239 use Carp;
  38         125  
  38         2757  
12 38     38   266 use POSIX qw(floor);
  38         107  
  38         239  
13 38     38   2953 use Scalar::Util qw(looks_like_number weaken);
  38         101  
  38         1979  
14              
15 38     38   252 use PDF::Builder::Basic::PDF::Utils;
  38         112  
  38         3121  
16 38     38   39419 use PDF::Builder::Content;
  38         154  
  38         1617  
17 38     38   395 use PDF::Builder::Content::Text;
  38         96  
  38         799  
18 38     38   250 use PDF::Builder::Util;
  38         88  
  38         153098  
19              
20             =head1 NAME
21              
22             PDF::Builder::Page - Methods to interact with individual pages
23              
24             =head1 SYNOPSIS
25              
26             my $pdf = PDF::Builder->new();
27              
28             # Add a page to a new or existing PDF
29             my $page = $pdf->page();
30              
31             # Set the physical (media) page size
32             # Set prepress page boundaries, a convenience function for those times when
33             # it is not necessary to set other prepress (print-related) page boundaries
34             $page->size('letter'); # by common size name
35             #$page->size([0, 0, 612, 792]); # by points LLx,LLy, URx,URy
36              
37             # alternately, can set (or get) prepress page boundaries
38             $page->boundaries('media' => '12x18', 'trim' => 0.5 * 72);
39              
40             # Add an image
41             my $image = $pdf->image('/path/to/file.jpg');
42             $page->object($image, $x,$y, $w,$h);
43              
44             # Create a content object for text
45             my $text = $page->text();
46              
47             # Create a content object for drawing shapes
48             my $canvas = $page->graphics(); # or gfx()
49              
50             # Now to draw graphics (using $canvas object) and text (using $text object).
51             # NOTE that everything in the graphics (canvas) object will be laid down on
52             # the page BEFORE anything in the text object is laid down. That is,
53             # text will cover graphics, but not vice-versa. This is simply due to
54             # the order in which the objects were defined.
55            
56             =head1 METHODS
57              
58             =over
59              
60             =item $page = PDF::Builder::Page->new($pdf, $parent, $index)
61              
62             Returns a page object (called from $pdf->page()).
63              
64             =cut
65              
66             sub new {
67 194     194 1 596 my ($class, $pdf, $parent, $index) = @_;
68 194         364 my $self = {};
69              
70 194 50       485 $class = ref($class) if ref($class);
71 194         815 $self = $class->SUPER::new($pdf, $parent);
72 194         677 $self->{'Type'} = PDFName('Page');
73 194         838 $self->proc_set(qw( PDF Text ImageB ImageC ImageI ));
74 194         660 delete $self->{'Count'};
75 194         455 delete $self->{'Kids'};
76 194         850 $parent->add_page($self, $index);
77              
78             # copy global UU (if exists) to local, possibly to be overridden
79             # we can access UserUnit (should be not 1.0, if exists) but not userUnit
80 194 50       570 if (defined $self->{'Parent'}->{'UserUnit'}) {
81 0         0 my $UU = $self->{'Parent'}->{'UserUnit'}->{'val'};
82 0         0 $self->{' userUnit'} = $UU;
83             # AND set the local one if global is not 1.0
84             # (some readers don't let a page inherit the global UU)
85 0 0       0 if ($UU != 1.0) {
86 0         0 $self->userunit($UU);
87             }
88             } else {
89             # not setting a global userUnit, so default this one to 1.0
90 194         441 $self->{' userUnit'} = 1;
91             # don't set a local UserUnit for now
92             }
93              
94 194         572 return $self;
95             }
96              
97             #=item $page = PDF::Builder::Page->coerce($pdf, $pdfpage)
98             #
99             #Returns a page object converted from $pdfpage (called from $pdf->open_page()).
100             #
101             #=cut
102              
103             # appears to be unused TBD
104              
105             sub coerce {
106 0     0 0 0 my ($class, $pdf, $page) = @_;
107 0         0 my $self = $page;
108 0         0 bless $self, $class;
109 0         0 $self->{' apipdf'} = $pdf;
110 0         0 weaken $self->{' apipdf'};
111 0         0 return $self;
112             }
113              
114             #=item $page->update()
115             #
116             #Marks a page to be updated (by $pdf->update()).
117             #
118             #=cut
119              
120             # appears to be internal routine
121             # replace any use by call to out_obj: $self->{' apipdf'}->out_obj($self);
122              
123             # PDF::API2 2.042: DEPRECATED
124             # Marking the page as dirty should only be needed in rare cases
125             # when the page hash is being edited directly rather than through the API. In
126             # that case, the out_obj call can be made manually. There's no reason (that I
127             # can think of) to have a specific call just (and only) for Page objects.
128              
129             sub update {
130 1     1 0 8 my $self = shift;
131              
132 1         6 $self->{' apipdf'}->out_obj($self);
133 1         2 return $self;
134             }
135              
136             =back
137              
138             =head2 Page Size Methods
139              
140             =over
141              
142             =item $page->userunit($value)
143              
144             Sets the User Unit for this one page.
145             See L for more information.
146              
147             =cut
148              
149             sub userunit {
150 0     0 1 0 my ($self, $value) = @_;
151              
152 0 0       0 if (float($value) <= 0.0) {
153 0         0 warn "Invalid User Unit value '$value', set to 1.0";
154 0         0 $value = 1.0;
155             }
156              
157             # assume that even if $value is 1.0, it's being called for some reason
158             # (perhaps overriding non-1.0 global setting)
159 0         0 $PDF::Builder::global_pdf->verCheckOutput(1.6, "set User Unit");
160 0         0 $self->{' userUnit'} = float($value); # this is local (page) UU
161 0         0 $self->{'UserUnit'} = PDFNum(float($value));
162              
163 0         0 return $self;
164             }
165              
166             sub _bbox {
167 127     127   374 my ($box, $self, @corners) = @_;
168             # $box is the box name (e.g., MediaBox)
169             # $self points to the page object
170             # at least one element in @corners if setting. get if no elements.
171              
172             # if 1 or 3 elements in @corners, and [0] contains a letter, it's a name
173 127         203 my $isName = 0;
174 127 100 100     641 if (scalar @corners && $corners[0] =~ m/[a-z]/i) { $isName = 1; }
  29         61  
175              
176 127 100       330 if (scalar @corners == 0) {
    50          
177             # is a query ('get')
178             # if previously set for this page, just return array
179             # if not set, check parent (PDF), then up chain as far as MediaBox
180 78 100       192 if (defined $self->{$box}) {
181 53         167 return map { $_->val() } $self->{$box}->elements();
  212         422  
182             } else {
183 25         41 my $pdf = $self->{' api'};
184 25 100       57 if (defined $pdf->{'pages'}->{$box}) {
185             # parent (global) box is defined
186 17         48 return map { $_->val() } $pdf->{'pages'}->{$box}->elements();
  68         141  
187             } else {
188             # go up the chain until find defined global
189 8 100 100     61 if ($box eq 'ArtBox' || $box eq 'TrimBox' || $box eq 'BleedBox') {
      100        
190 6         11 $box = 'CropBox';
191             }
192 8 50 33     46 if ($box eq 'CropBox' && !defined $pdf->{'pages'}->{'CropBox'}) {
193 8         12 $box = 'MediaBox';
194             }
195 8 50 33     26 if ($box ne 'CropBox' && $box ne 'MediaBox') {
196             # invalid box name. silent error: just return Media Box
197 0         0 $box = 'MediaBox';
198             }
199 8         33 return map { $_->val() } $pdf->{'pages'}->{$box}->elements();
  32         67  
200             }
201             }
202            
203             } elsif (scalar @corners == 3) {
204             # have a name and one option (orient)
205 0         0 my ($name, %opts) = @corners;
206             # copy dashed option names to preferred undashed names
207 0 0 0     0 if (defined $opts{'-orient'} && !defined $opts{'orient'}) { $opts{'orient'} = delete($opts{'-orient'}); }
  0         0  
208              
209 0         0 @corners = page_size(($name)); # now 4 numeric values
210 0 0       0 if (defined $opts{'orient'}) {
211 0 0       0 if ($opts{'orient'} =~ m/^l/i) { # 'landscape' or just 'l'
212             # 0 0 W H -> 0 0 H W
213 0         0 my $temp;
214 0         0 $temp = $corners[2]; $corners[2] = $corners[3]; $corners[3] = $temp;
  0         0  
  0         0  
215             }
216             }
217             } else {
218             # name without [orient] option, or numeric coordinates given
219 49         215 @corners = page_size(@corners);
220             }
221              
222             # scale down size if User Unit given (e.g., Letter => 0 0 8.5 11)
223             # we have a global userUnit, and possibly a page userUnit overriding it
224 49 100       144 if ($isName) {
225 29         65 my $UU = $self->{' userUnit'};
226 29 50       82 if ($UU != 1.0) {
227 0         0 for (my $i=0; $i<4; $i++) {
228 0         0 $corners[$i] /= $UU;
229             }
230             }
231             }
232              
233 49         106 $self->{$box} = PDFArray( map { PDFNum(float($_)) } @corners );
  196         427  
234             # return 4 element array of box corners
235 49         156 return @corners;
236             }
237              
238             =item $page->mediabox($alias)
239              
240             =item $page->mediabox($alias, 'orient' => 'orientation')
241              
242             =item $page->mediabox($w,$h)
243              
244             =item $page->mediabox($llx,$lly, $urx,$ury)
245              
246             =item ($llx,$lly, $urx,$ury) = $page->mediabox()
247              
248             Sets or gets the Media Box for this one page.
249             See L for more information.
250             The method always returns the current bounds (after any set operation).
251              
252             =cut
253              
254             sub mediabox {
255 75     75 1 80662 return _bbox('MediaBox', @_);
256             }
257              
258             =item ($llx,$lly, $urx,$ury) = $page->get_mediabox()
259              
260             Gets the Media Box corner coordinates based on best estimates or the default.
261             These are in the order given in a mediabox call (4 coordinates).
262              
263             This method is B, and will likely be removed in the future. Use
264             the global (C<$pdf>) or page (C<$page>) mediabox() call with no parameters
265             instead.
266              
267             =cut
268              
269             sub get_mediabox {
270 9     9 1 72 my $self = shift();
271 9         25 return $self->mediabox();
272             }
273              
274             =item $page->cropbox($alias)
275              
276             =item $page->cropbox($alias, 'orient' => 'orientation')
277              
278             =item $page->cropbox($w,$h)
279              
280             =item $page->cropbox($llx,$lly, $urx,$ury)
281              
282             =item ($llx,$lly, $urx,$ury) = $page->cropbox()
283              
284             Sets or gets the Crop Box for this one page.
285             See L for more information.
286             The method always returns the current bounds (after any set operation).
287              
288             =cut
289              
290             sub cropbox {
291 13     13 1 4309 return _bbox('CropBox', @_);
292             }
293              
294             =item ($llx,$lly, $urx,$ury) = $page->get_cropbox()
295              
296             Gets the Crop Box based on best estimates or the default.
297              
298             This method is B, and will likely be removed in the future. Use
299             the global (C<$pdf>) or page (C<$page>) cropbox() call with no parameters
300             instead.
301              
302             =cut
303              
304             sub get_cropbox {
305 6     6 1 26 my $self = shift();
306 6         15 return $self->cropbox();
307             }
308              
309             =item $page->bleedbox($alias)
310              
311             =item $page->bleedbox($alias, 'orient' => 'orientation')
312              
313             =item $page->bleedbox($w,$h)
314              
315             =item $page->bleedbox($llx,$lly, $urx,$ury)
316              
317             =item ($llx,$lly, $urx,$ury) = $page->bleedbox()
318              
319             Sets or gets or gets the Bleed Box for this one page.
320             See L for more information.
321             The method always returns the current bounds (after any set operation).
322              
323             =cut
324              
325             sub bleedbox {
326 13     13 1 4433 return _bbox('BleedBox', @_);
327             }
328              
329             =item ($llx,$lly, $urx,$ury) = $page->get_bleedbox()
330              
331             Gets the Bleed Box based on best estimates or the default.
332              
333             This method is B, and will likely be removed in the future. Use
334             the global (C<$pdf>) or page (C<$page>) bleedbox() call with no parameters
335             instead.
336              
337             =cut
338              
339             sub get_bleedbox {
340 6     6 1 88 my $self = shift();
341 6         19 return $self->bleedbox();
342             }
343              
344             =item $page->trimbox($alias)
345              
346             =item $page->trimbox($alias, 'orient' => 'orientation')
347              
348             =item $page->trimbox($w,$h)
349              
350             =item $page->trimbox($llx,$lly, $urx,$ury)
351              
352             =item ($llx,$lly, $urx,$ury) = $page->trimbox()
353              
354             Sets or gets the Trim Box for this one page.
355             See L for more information.
356             The method always returns the current bounds (after any set operation).
357              
358             =cut
359              
360             sub trimbox {
361 13     13 1 4397 return _bbox('TrimBox', @_);
362             }
363              
364             =item ($llx,$lly, $urx,$ury) = $page->get_trimbox()
365              
366             Gets the Trim Box based on best estimates or the default.
367              
368             This method is B, and will likely be removed in the future. Use
369             the global (C<$pdf>) or page (C<$page>) trimbox() call with no parameters
370             instead.
371              
372             =cut
373              
374             sub get_trimbox {
375 6     6 1 38 my $self = shift();
376 6         16 return $self->trimbox();
377             }
378              
379             =item $page->artbox($alias)
380              
381             =item $page->artbox($alias, 'orient' => 'orientation')
382              
383             =item $page->artbox($w,$h)
384              
385             =item $page->artbox($llx,$lly, $urx,$ury)
386              
387             =item ($llx,$lly, $urx,$ury) = $page->artbox()
388              
389             Sets or gets the Art Box for this one page.
390             See L for more information.
391             The method always returns the current bounds (after any set operation).
392              
393             =cut
394              
395             sub artbox {
396 13     13 1 4352 return _bbox('ArtBox', @_);
397             }
398              
399             =item ($llx,$lly, $urx,$ury) = $page->get_artbox()
400              
401             Gets the Art Box based on best estimates or the default.
402              
403             This method is B, and will likely be removed in the future. Use
404             the global (C<$pdf>) or page (C<$page>) artbox() call with no parameters
405             instead.
406              
407             =cut
408              
409             sub get_artbox {
410 6     6 1 35 my $self = shift();
411 6         16 return $self->artbox();
412             }
413              
414             =item $page->rotate($deg)
415              
416             Rotates the page by the given degrees, which must be a multiple of 90.
417             An angle that is not a multiple of 90 will be rounded to the nearest 90
418             degrees, with a message.
419              
420             Note that the rotation angle is I for a positive amount!
421             E.g., a rotation of +90 (or -270) will have the bottom edge of the paper at
422             the left of the screen.
423             After rotating the page 180 degrees, C<[0, 0]> (originally lower left corner)
424             will be be in the top right corner of the page, rather than the bottom left.
425             X will increase to the right, and Y will increase downward.
426              
427             (This allows you to auto-rotate to landscape without changing the mediabox!
428             There are other ways to accomplish this end, such as using the C
429             method, which will not change the coordinate system (move the origin).)
430              
431             B that some users have reported problems with using C, that
432             the dimensions were limited to the smaller of the original height or width. If
433             you experience this, be sure to check whether you are doing some sort of I
434             box> or other clipping, that might not rotate as expected with the rest of the
435             page. In other words, you might need to manually adjust the crop box dimensions.
436              
437             Do not confuse this C call with the I rotation
438             (Content.pm) C, which permits any angle, is of opposite direction,
439             and does not shift the origin!
440              
441             B C
442              
443             This has been added for PDF::API2 compatibility.
444              
445             =cut
446              
447 0     0 0 0 sub rotation { return rotate(@_); } ## no critic
448              
449             sub rotate {
450 0     0 1 0 my ($self, $degrees) = @_;
451              
452 0   0     0 $degrees //= 0;
453             # Ignore rotation of 360 or more (in either direction)
454 0         0 $degrees = $degrees % 360; # range [0, 360)
455              
456 0 0       0 if ($degrees % 90) {
457 0         0 my $deg = int(($degrees + 45)/90)*90;
458 0         0 carp "page rotate($degrees) invalid, not multiple of 90 degrees.\nChanged to $deg";
459 0         0 $degrees = $deg;
460             }
461              
462 0         0 $self->{'Rotate'} = PDFNum($degrees);
463              
464 0         0 return $self;
465             }
466              
467             =item $page->size($size) # Set
468              
469             =item @rectangle = $page->size() # Get
470              
471             Set the physical page size or return the coordinates of the rectangle enclosing
472             the physical page size.
473             This is an alternate method provided for compatibility with PDF::API2.
474              
475             # Set the physical page (media) size using a common size name
476             $page->size('letter');
477              
478             # Set the page size using coordinates in points (X1, Y1, X2, Y2)
479             $page->size([0, 0, 612, 792]);
480              
481             # Get the page coordinates in points
482             my @rectangle = $page->size();
483              
484             See Page Sizes below for possible values.
485             The size method is a convenient shortcut for setting the PDF's media box when
486             other prepress (print-related) page boundaries aren't required. It's equivalent
487             to the following:
488              
489             # Set
490             $page = $page->boundaries('media' => $size);
491              
492             # Get
493             @rectangle = $page->boundaries()->{'media'}->@*;
494              
495             =cut
496            
497             sub size {
498 1     1 1 2602 my $self = shift;
499              
500 1 50       5 if (@_) { # Set (also returns object, for easy chaining)
501 1         6 return $self->boundaries('media' => @_);
502             } else { # Get
503 0         0 my %boundaries = $self->boundaries();
504 0         0 return @{ $boundaries{'media'} };
  0         0  
505             }
506             }
507              
508             =item $page = $page->boundaries(%boundaries)
509              
510             =item \%boundaries = $page->boundaries()
511              
512             Set prepress page boundaries to facilitate printing. Returns the current page
513             boundaries if called without arguments.
514             This is an alternate method provided for compatibility with PDF::API2.
515              
516             # Set
517             $page->boundaries(
518             # 13x19 inch physical sheet size
519             'media' => '13x19',
520             # sheet content is 11x17 with 0.25" bleed
521             'bleed' => [0.75 * 72, 0.75 * 72, 12.25 * 72, 18.25 * 72],
522             # 11x17 final trimmed size
523             'trim' => 0.25 * 72,
524             );
525              
526             # Get
527             %boundaries = $page->boundaries();
528             ($x1,$y1, $x2,$y2) = $page->boundaries('trim');
529              
530             The C<%boundaries> hash contains one or more page boundary keys (see Page
531             Boundaries) to set or replace, each with a corresponding size (see Page Sizes).
532              
533             If called without arguments, the returned hashref will contain (Get) all five
534             boundaries. If called with one string argument, it returns the coordinates for
535             the specified page boundary. If more than one boundary type is given, only the
536             first is processed, and a warning is given that the remainder are ignored.
537              
538             =back
539              
540             =head3 Page Boundaries
541              
542             PDF defines five page boundaries. When creating PDFs for print shops, you'll
543             most commonly use just the media box and trim box. Traditional print shops may
544             also use the bleed box when adding printer's marks and other information.
545              
546             =over
547              
548             =item media
549              
550             The media box defines the boundaries of the physical medium on which the page is
551             to be printed. It may include any extended area surrounding the finished page
552             for bleed, printing marks, or other such purposes. The default value is as
553             defined for PDF, a US letter page (8.5" x 11").
554              
555             =item crop
556              
557             The crop box defines the region to which the contents of the page shall be
558             clipped (cropped) when displayed or printed. The default value is the page's
559             media box.
560             This is a historical page boundary. You'll likely want to set the bleed and/or
561             trim boxes instead.
562              
563             =item bleed
564              
565             The bleed box defines the region to which the contents of the page shall be
566             clipped when output in a production environment. This may include any extra
567             bleed area needed to accommodate the physical limitations of cutting, folding,
568             and trimming equipment. The actual printed page (media box) may include
569             printing marks that fall outside the bleed box. The default value is the page's
570             crop box.
571              
572             =item trim
573              
574             The trim box defines the intended dimensions of the finished page after
575             trimming. It may be smaller than the media box to allow for production-related
576             content, such as printing instructions, cut marks, or color bars. The default
577             value is the page's crop box.
578              
579             =item art
580              
581             The art box defines the extent of the page's meaningful content (including
582             potential white space) as intended by the page's creator. The default value is
583             the page's crop box.
584              
585             =back
586              
587             =head3 Page Sizes
588              
589             PDF page sizes are stored as rectangular coordinates. For convenience,
590             PDF::Builder also supports a number of aliases and shortcuts that are more
591             human-friendly. The following formats are available:
592              
593             =over
594              
595             =item a standard paper size
596              
597             $page->boundaries('media' => 'A4');
598              
599             Aliases for the most common paper sizes are built in (case-insensitive).
600             US: Letter, Legal, Ledger, Tabloid (and others)
601             Metric: 4A0, 2A0, A0 - A6, 4B0, 2B0, and B0 - B6 (and others)
602              
603             =item a "WxH" string in inches
604              
605             $page->boundaries('media' => '8.5x11');
606              
607             Many US paper sizes are commonly identified by their size in inches rather than
608             by a particular name. These can be passed as strings with the width and height
609             separated by an C.
610             Examples: C<4x6>, C<12x18>, C<8.5x11>
611              
612             =item a number representing a reduction (in points) from the next-larger box
613              
614             For example, a 12" x 18" physical sheet to be trimmed down to an 11" x 17" sheet
615             can be specified as follows:
616              
617             # Note: There are 72 points per inch
618             $page->boundaries('media' => '12x18', 'trim' => 0.5 * 72);
619              
620             # Equivalent
621             $page->boundaries('media' => [0, 0, 12 * 72, 18 * 72],
622             'trim' => [0.5 * 72, 0.5 * 72, 11.5 * 72, 17.5 * 72]);
623              
624             This example shows a 12" x 18" physical sheet that will be reduced to a final
625             size of 11" x 17" by trimming 0.5" from each edge. The smaller page boundary is
626             assumed to be centered within the larger one.
627              
628             The "next-larger box" follows this order, stopping at the first defined value:
629              
630             art -> trim -> bleed -> media
631             crop -> media
632              
633             This option isn't available for the media box, since it is by definition, the
634             largest boundary.
635              
636             =item [$width, $height] in points
637              
638             $page->boundaries('media' => [8.5 * 72, 11 * 7.2]);
639              
640             For other page or boundary sizes, the width and height (in points) can be given
641             directly as an array.
642              
643             =item [$x1, $y1, $x2, $y2] in points
644              
645             $page->boundaries('media' => [0, 0, 8.5 * 72, 11 * 72]);
646              
647             Finally, the absolute (raw) coordinates of the bottom-left and top-right corners
648             of a rectangle can be specified.
649              
650             =cut
651              
652             sub _to_rectangle {
653 6     6   11 my $value = shift();
654              
655             # An array of two or four numbers in points
656 6 50       13 if (ref($value) eq 'ARRAY') {
657 0 0       0 if (@$value == 2) {
    0          
658 0         0 return (0, 0, @$value);
659             } elsif (@$value == 4) {
660 0         0 return @$value;
661             }
662 0         0 croak "Page boundary array must contain two or four numbers";
663             }
664              
665             # WxH in inches
666 6 100       28 if ($value =~ /^([0-9.]+)\s*x\s*([0-9.]+)$/) {
667 2         9 my ($w, $h) = ($1, $2);
668 2 50 33     16 if (looks_like_number($w) and looks_like_number($h)) {
669 2         9 return (0, 0, $w * 72, $h * 72);
670             }
671             }
672              
673             # Common names for page sizes
674 4         13 my %page_sizes = PDF::Builder::Resource::PaperSizes::get_paper_sizes();
675              
676 4 50       38 if ($page_sizes{lc $value}) {
677 4         6 return (0, 0, @{$page_sizes{lc $value}});
  4         73  
678             }
679              
680 0 0       0 if (ref($value)) {
681 0         0 croak "Unrecognized page size";
682             } else {
683 0         0 croak "Unrecognized page size: $value";
684             }
685             }
686              
687             sub boundaries {
688 6     6 1 5138 my $self = shift();
689              
690             # Get
691 6 50       25 if (@_ == 0) { # empty list -- do all boxes
    50          
692 0         0 my %boundaries;
693 0         0 foreach my $box (qw(Media Crop Bleed Trim Art)) {
694 0         0 $boundaries{lc($box)} = [$self->_bounding_box($box . 'Box')];
695             }
696 0         0 return %boundaries;
697             } elsif (@_ == 1) { # request one specific box
698 0         0 my $box = shift();
699             # apparently it is normal to have an array of boxes, and use only first
700             #if (@_) { # more than one box in arg list?
701             # carp "More than one box requested for boundaries(). Using only first ($box)";
702             #}
703 0         0 my @coordinates = $self->_bounding_box(ucfirst($box) . 'Box');
704 0         0 return @coordinates;
705             }
706              
707             # Set
708 6         20 my %boxes = @_;
709 6         13 foreach my $box (qw(media crop bleed trim art)) {
710 30 100       71 next unless exists $boxes{$box};
711              
712             # Special case: A single number as the value for anything other than
713             # MediaBox means to take the next larger size and reduce it by this
714             # amount in points on all four sides, provided the larger size was also
715             # included.
716 8         26 my $value = $boxes{$box};
717 8         12 my @rectangle;
718 8 100 66     33 if ($box ne 'media' and not ref($value) and looks_like_number($value)) {
      66        
719 2 50       11 my $parent = ($box eq 'crop' ? 'media' :
    50          
    50          
720             $box eq 'bleed' ? 'media' :
721             $box eq 'trim' ? 'bleed' : 'trim');
722 2 50 33     7 $parent = 'bleed' if $parent eq 'trim' and not $boxes{'trim'};
723 2 50 33     10 $parent = 'media' if $parent eq 'bleed' and not $boxes{'bleed'};
724 2 50 33     6 $parent = 'media' if $parent eq 'bleed' and not $boxes{'bleed'};
725 2 50       7 unless ($boxes{$parent}) {
726 0         0 croak "Single-number argument for $box requires $parent";
727             }
728              
729 2         4 @rectangle = @{$boxes{$parent}};
  2         5  
730 2         4 $rectangle[0] += $value;
731 2         3 $rectangle[1] += $value;
732 2         4 $rectangle[2] -= $value;
733 2         3 $rectangle[3] -= $value;
734             }
735             else {
736 6         14 @rectangle = _to_rectangle($value);
737             }
738              
739 8         43 my $box_name = ucfirst($box) . 'Box';
740 8         31 $self->_bounding_box($box_name, @rectangle);
741 8         26 $boxes{$box} = [@rectangle];
742             }
743              
744 6         23 return $self;
745             }
746              
747             sub _bounding_box {
748 8     8   2609 my $self = shift();
749 8         13 my $type = shift();
750              
751             # Get
752 8 100       19 unless (scalar @_) {
753 4         12 my $box = $self->find_prop($type);
754 4 50       10 unless ($box) {
755             # Default to letter (for historical PDF::API2 reasons, not per the
756             # PDF specification)
757 0 0       0 return (0, 0, 612, 792) if $type eq 'MediaBox';
758              
759             # Use defaults per PDF 1.7 section 14.11.2 Page Boundaries
760 0 0       0 return $self->_bounding_box('MediaBox') if $type eq 'CropBox';
761 0         0 return $self->_bounding_box('CropBox');
762             }
763 4         13 return map { $_->val() } $box->elements();
  16         33  
764             }
765              
766             # Set
767 4         15 $self->{$type} = PDFArray(map { PDFNum(float($_)) } page_size(@_));
  16         58  
768 4         9 return $self;
769             }
770              
771             sub fixcontents {
772 161     161 0 314 my ($self) = @_;
773              
774 161   66     712 $self->{'Contents'} = $self->{'Contents'} || PDFArray();
775 161 50       683 if (ref($self->{'Contents'}) =~ /Objind$/) {
776 0         0 $self->{'Contents'}->realise();
777             }
778 161 50       841 if (ref($self->{'Contents'}) !~ /Array$/) {
779 0         0 $self->{'Contents'} = PDFArray($self->{'Contents'});
780             }
781 161         335 return;
782             }
783              
784             sub content {
785 154     154 0 320 my ($self, $obj, $dir) = @_;
786              
787 154 50 33     662 if (defined($dir) && $dir > 0) {
788 0         0 $self->precontent($obj);
789             } else {
790 154         447 $self->addcontent($obj);
791             }
792 154 50       627 $self->{' apipdf'}->new_obj($obj) unless $obj->is_obj($self->{' apipdf'});
793 154         734 $obj->{' apipdf'} = $self->{' apipdf'};
794 154         364 $obj->{' api'} = $self->{' api'};
795 154         296 $obj->{' apipage'} = $self;
796              
797 154         542 weaken $obj->{' apipdf'};
798 154         431 weaken $obj->{' api'};
799 154         394 weaken $obj->{' apipage'};
800              
801 154         253 return $obj;
802             }
803              
804             sub addcontent {
805 154     154 0 344 my ($self, @objs) = @_;
806              
807 154         449 $self->fixcontents();
808 154         536 $self->{'Contents'}->add_elements(@objs);
809 154         281 return;
810             }
811              
812             sub precontent {
813 0     0 0 0 my ($self, @objs) = @_;
814              
815 0         0 $self->fixcontents();
816 0         0 unshift(@{$self->{'Contents'}->val()}, @objs);
  0         0  
817 0         0 return;
818             }
819              
820             =item $gfx = $page->gfx(%opts)
821              
822             =item $gfx = $page->gfx($prepend)
823              
824             =item $gfx = $page->gfx()
825              
826             Returns a graphics content object, for drawing paths and shapes.
827              
828             You may specify the "prepend" flag in the old or new way. The old way is to
829             give a single boolean value (0 false, non-zero true). The new way is to give
830             a hash element named 'prepend', with the same values.
831              
832             =over
833              
834             =item gfx(boolean_value $prepend)
835              
836             =item gfx('prepend' => boolean_value)
837              
838             =back
839              
840             If $prepend is I, or the option 'prepend' is given with a I value,
841             the content will be prepended to the page description (at the beginning of
842             the page's content stream).
843             Otherwise, it will be appended.
844             The default is I.
845              
846             =over
847              
848             =item gfx('compress' => boolean_value)
849              
850             =back
851              
852             You may specify a compression flag saying whether the drawing instructions
853             are to be compressed. If not given, the default is for the overall PDF
854             compression setting to be used (I by default).
855              
856             You may have more than one I object. They and I objects will be
857             output as objects and streams I, with all actions pertaining
858             to this I object appearing in one stream. However, note that graphics
859             and text objects are not fully independent of each other: the exit state
860             (linewidth, strokecolor, etc.) of one object is the entry state of the next
861             object in line to be output, and so on.
862              
863             If you intermix multiple I and I objects on
864             a page, the results may be confusing. Say you have $gfx1, $text1, $gfx2, and
865             $text2 on your page (I). PDF::Builder will output all the
866             $gfx1->I calls in one stream, then all the $text1->I calls in
867             the next stream, and likewise for $gfx2 usage and finally $text2.
868              
869             Then it's PDF's turn to confuse you. PDF will process the entire $gfx1 object
870             stream, accumulating the graphics state to the end of the stream, and using
871             that as the entry state into $text1. In a similar manner, $gfx2 and $text2 are
872             read, processed, and rendered. Thus, a change in, say, the dash pattern in the
873             middle of $gfx1, I you have output some $gfx2, $text1, and $text2
874             material, may suddenly show up at the beginning of $text1 (and continue through
875             $gfx2 and $text2)!
876              
877             It is possible to use multiple graphics objects, to avoid having to change
878             settings constantly, but you may want to consider resetting all your settings
879             at the first call to each object, so that you are starting from a known base.
880             This may most easily be done by using $I->restore() and ->save() just
881             after creating $I:
882              
883             =over
884              
885             $text1 = $page->text();
886             $text1->save();
887             $grfx1 = $page->gfx();
888             $grfx1->restore();
889             $grfx1->save();
890             $text2 = $page->text();
891             $text2->restore();
892             $text2->save();
893             $grfx2 = $page->gfx();
894             $grfx1->restore();
895              
896             =back
897              
898             B C
899              
900             This has been added for PDF::API2 compatibility.
901              
902             =cut
903              
904 3     3 0 11 sub graphics { return gfx(@_); } ## no critic
905              
906             sub gfx {
907 134     134 1 676 my ($self, @params) = @_;
908              
909 134         218 my ($prepend, $compress);
910 134         240 $prepend = $compress = 0; # default for both is False
911 134 50       344 if (scalar @params == 0) {
    0          
    0          
912             # gfx() call. no change
913             } elsif (scalar @params == 1) {
914             # one scalar value, $prepend
915 0         0 $prepend = $params[0];
916             } elsif ((scalar @params)%2) {
917             # odd number of values, can't be a hash list
918 0         0 carp "Invalid parameters passed to gfx or graphics call!";
919             } else {
920             # hash list with at least one element
921 0         0 my %hash = @params;
922             # copy dashed hash names to preferred undashed names
923 0 0 0     0 if (defined $hash{'-prepend'} && !defined $hash{'prepend'}) { $hash{'prepend'} = delete($hash{'-prepend'}); }
  0         0  
924 0 0 0     0 if (defined $hash{'-compress'} && !defined $hash{'compress'}) { $hash{'compress'} = delete($hash{'-compress'}); }
  0         0  
925              
926 0 0       0 if (defined $hash{'prepend'}) { $prepend = $hash{'prepend'}; }
  0         0  
927 0 0       0 if (defined $hash{'compress'}) { $compress = $hash{'compress'}; }
  0         0  
928             }
929 134 50       337 if ($prepend) { $prepend = 1; }
  0         0  
930             $compress //= $self->{' api'}->{'forcecompress'} eq 'flate' ||
931 134   0     307 $self->{' api'}->{'forcecompress'} =~ m/^[1-9]\d*$/;
      33        
932              
933 134         773 my $gfx = PDF::Builder::Content->new();
934 134 50       305 $gfx->compressFlate() if $compress;
935 134         438 $self->content($gfx, $prepend);
936              
937 134         619 return $gfx;
938             }
939              
940             =item $text = $page->text(%opts)
941              
942             =item $text = $page->text($prepend)
943              
944             =item $text = $page->text()
945              
946             Returns a text content object, for writing text.
947             See L for details.
948              
949             You may specify the "prepend" flag in the old or new way. The old way is to
950             give a single boolean value (0 false, non-zero true). The new way is to give
951             a hash element named 'prepend', with the same values.
952              
953             =over
954              
955             =item text(boolean_value $prepend)
956              
957             =item text('prepend' => boolean_value)
958              
959             =back
960              
961             If $prepend is I, or the option 'prepend' is given with a I value,
962             the content will be prepended to the page description (at the beginning of
963             the page's content stream).
964             Otherwise, it will be appended.
965             The default is I.
966              
967             =over
968              
969             =item text('compress' => boolean_value)
970              
971             =back
972              
973             You may specify a compression flag saying whether the text content is
974             to be compressed. If not given, the default is for the overall PDF
975             compression setting to be used (I by default).
976              
977             Please see the discussion above in C regarding multiple graphics and
978             text objects on one page, how they are grouped into PDF objects and streams,
979             and the rendering consequences of running through one entire object at a time,
980             before moving on to the next.
981              
982             The I object has many settings and attributes of its own, but shares many
983             with graphics (I), such as strokecolor, fillcolor, linewidth, linedash,
984             and the like. Thus there is some overlap in attributes, and graphics and text
985             calls can affect each other.
986              
987             =cut
988              
989             sub text {
990 20     20 1 1061 my ($self, @params) = @_;
991              
992 20         47 my ($prepend, $compress);
993 20         45 $prepend = $compress = 0; # default for both is False
994 20 50       73 if (scalar @params == 0) {
    0          
    0          
995             # text() call. no change
996             } elsif (scalar @params == 1) {
997             # one scalar value, $prepend
998 0         0 $prepend = $params[0];
999             } elsif ((scalar @params)%2) {
1000             # odd number of values, can't be a hash list
1001 0         0 carp "Invalid parameters passed to text() call!";
1002             } else {
1003             # hash list with at least one element
1004 0         0 my %hash = @params;
1005             # copy dashed hash names to preferred undashed names
1006 0 0 0     0 if (defined $hash{'-prepend'} && !defined $hash{'prepend'}) { $hash{'prepend'} = delete($hash{'-prepend'}); }
  0         0  
1007 0 0 0     0 if (defined $hash{'-compress'} && !defined $hash{'compress'}) { $hash{'compress'} = delete($hash{'-compress'}); }
  0         0  
1008              
1009 0 0       0 if (defined $hash{'prepend'}) { $prepend = $hash{'prepend'}; }
  0         0  
1010 0 0       0 if (defined $hash{'compress'}) { $compress = $hash{'compress'}; }
  0         0  
1011             }
1012 20 50       60 if ($prepend) { $prepend = 1; }
  0         0  
1013             $compress //= $self->{' api'}->{'forcecompress'} eq 'flate' ||
1014 20   0     57 $self->{' api'}->{'forcecompress'} =~ m/^[1-9]\d*$/;
      33        
1015              
1016 20         192 my $text = PDF::Builder::Content::Text->new();
1017 20 50       78 $text->compressFlate() if $compress;
1018 20         111 $self->content($text, $prepend);
1019              
1020 20         96 return $text;
1021             }
1022              
1023             =item $page = $page->object($object, $x,$y, $scale_x,$scale_y)
1024              
1025             Places an image or other external object (a.k.a. XObject) on the page in the
1026             specified location.
1027              
1028             For images, C<$scale_x> and C<$scale_y> represent the width and height of the
1029             image on the page in points. If C<$scale_x> is omitted, it will default to 72
1030             pixels per inch. If C<$scale_y> is omitted, the image will be scaled
1031             proportionally based on the image dimensions.
1032              
1033             For other external objects, the scale is a multiplier, where 1 (the default)
1034             represents 100% (i.e. no change).
1035              
1036             If the object to be placed depends on a coordinate transformation (e.g. rotation
1037             or skew), first create a content object using L, then call
1038             L after making the appropriate transformations.
1039              
1040             =cut
1041              
1042             sub object {
1043 0     0 1 0 my $self = shift();
1044 0         0 $self->graphics()->object(@_);
1045 0         0 return $self;
1046             }
1047              
1048             =item $ant = $page->annotation()
1049              
1050             Returns a new annotation object.
1051              
1052             =cut
1053              
1054             sub annotation {
1055 6     6 1 55 my $self = shift;
1056              
1057 6 100 33     20 unless (exists $self->{'Annots'}) {
1058 5         25 $self->{'Annots'} = PDFArray();
1059 5         24 $self->{' apipdf'}->out_obj($self);
1060             } elsif (ref($self->{'Annots'}) =~ /Objind/) {
1061             $self->{'Annots'}->realise();
1062             }
1063              
1064 6         636 require PDF::Builder::Annotation;
1065 6         44 my $ant = PDF::Builder::Annotation->new();
1066 6         21 $self->{'Annots'}->add_elements($ant);
1067 6         22 $self->{' apipdf'}->new_obj($ant);
1068 6         13 $ant->{' apipdf'} = $self->{' apipdf'};
1069 6         12 $ant->{' apipage'} = $self;
1070 6         22 weaken $ant->{' apipdf'};
1071 6         17 weaken $ant->{' apipage'};
1072              
1073 6 100       19 if ($self->{'Annots'}->is_obj($self->{' apipdf'})) {
1074 1         4 $self->{' apipdf'}->out_obj($self->{'Annots'});
1075             }
1076              
1077 6         37 return $ant;
1078             }
1079              
1080             =item $page->resource($type, $key, $obj)
1081              
1082             Adds a resource to the page-inheritance tree.
1083              
1084             B
1085              
1086             $co->resource('Font', $fontkey, $fontobj);
1087             $co->resource('XObject', $imagekey, $imageobj);
1088             $co->resource('Shading', $shadekey, $shadeobj);
1089             $co->resource('ColorSpace', $spacekey, $speceobj);
1090              
1091             B You only have to add the required resources if
1092             they are NOT handled by the *font*, *image*, *shade* or *space*
1093             methods.
1094              
1095             =cut
1096              
1097             sub resource {
1098 32     32 1 127 my ($self, $type, $key, $obj, $force) = @_;
1099              
1100 32         151 my $dict = $self->find_prop('Resources');
1101              
1102 32   0     165 $dict = $dict || $self->{'Resources'} || PDFDict();
1103              
1104 32 50       225 $dict->realise() if ref($dict) =~ /Objind$/;
1105              
1106 32   66     239 $dict->{$type} = $dict->{$type} || PDFDict();
1107 32 50       194 $dict->{$type}->realise() if ref($dict->{$type}) =~ /Objind$/;
1108              
1109 32 100       143 unless (defined $obj) {
1110 2   50     16 return $dict->{$type}->{$key} || undef;
1111             } else {
1112 30 50       114 if ($force) {
1113 0         0 $dict->{$type}->{$key} = $obj;
1114             } else {
1115 30   33     265 $dict->{$type}->{$key} = $dict->{$type}->{$key} || $obj;
1116             }
1117              
1118 30 50       127 $self->{' apipdf'}->out_obj($dict) if $dict->is_obj($self->{' apipdf'});
1119 30 50       150 $self->{' apipdf'}->out_obj($dict->{$type}) if $dict->{$type}->is_obj($self->{' apipdf'});
1120 30 100       142 $self->{' apipdf'}->out_obj($obj) if $obj->is_obj($self->{' apipdf'});
1121 30         137 $self->{' apipdf'}->out_obj($self);
1122              
1123 30         124 return $dict;
1124             }
1125             }
1126              
1127             sub ship_out {
1128 0     0 0   my ($self, $pdf) = @_;
1129              
1130 0           $pdf->ship_out($self);
1131 0 0         if (defined $self->{'Contents'}) {
1132 0           $pdf->ship_out($self->{'Contents'}->elements());
1133             }
1134 0           return $self;
1135             }
1136              
1137             #sub outobjdeep {
1138             # my ($self, @opts) = @_;
1139             #
1140             # foreach my $k (qw/ api apipdf /) {
1141             # $self->{" $k"} = undef;
1142             # delete($self->{" $k"});
1143             # }
1144             # return $self->SUPER::outobjdeep(@opts);
1145             #}
1146              
1147             =back
1148              
1149             =cut
1150              
1151             1;