File Coverage

blib/lib/PDF/Builder/Outline.pm
Criterion Covered Total %
statement 72 128 56.2
branch 27 54 50.0
condition 4 8 50.0
subroutine 16 24 66.6
pod 10 17 58.8
total 129 231 55.8


line stmt bran cond sub pod time code
1             package PDF::Builder::Outline;
2              
3 2     2   19 use base 'PDF::Builder::Basic::PDF::Dict';
  2         5  
  2         245  
4              
5 2     2   13 use strict;
  2         5  
  2         45  
6 2     2   9 use warnings;
  2         4  
  2         108  
7              
8             our $VERSION = '3.023'; # VERSION
9             our $LAST_UPDATE = '3.020'; # manually update whenever code is changed
10              
11 2     2   11 use Carp qw(croak);
  2         4  
  2         113  
12 2     2   16 use PDF::Builder::Basic::PDF::Utils;
  2         3  
  2         192  
13 2     2   13 use Scalar::Util qw(weaken);
  2         5  
  2         3502  
14              
15             =head1 NAME
16              
17             PDF::Builder::Outline - Manage PDF outlines (a.k.a. I)
18              
19             =head1 METHODS
20              
21             =over
22              
23             =item $outline = PDF::Builder::Outline->new($api, $parent, $prev)
24              
25             Returns a new outline object (called from $outlines->outline()).
26              
27             =cut
28              
29             sub new {
30 2     2 1 5 my ($class, $api, $parent, $prev) = @_;
31 2         9 my $self = $class->SUPER::new();
32              
33 2 100       6 $self->{'Parent'} = $parent if defined $parent;
34 2 50       4 $self->{'Prev'} = $prev if defined $prev;
35 2         5 $self->{' api'} = $api;
36 2         8 weaken $self->{' api'};
37 2 100       7 weaken $self->{'Parent'} if defined $parent;
38 2 50       6 weaken $self->{'Prev'} if defined $prev;
39              
40 2         4 return $self;
41             }
42              
43             # unused?
44             sub parent {
45 0     0 0 0 my $self = shift();
46 0 0       0 $self->{'Parent'} = shift() if defined $_[0];
47 0         0 weaken $self->{'Parent'};
48 0         0 return $self->{'Parent'};
49             }
50              
51             # internal routine
52             sub prev {
53 0     0 0 0 my $self = shift();
54 0 0       0 $self->{'Prev'} = shift() if defined $_[0];
55 0         0 weaken $self->{'Prev'};
56 0         0 return $self->{'Prev'};
57             }
58              
59             # internal routine
60             sub next {
61 0     0 0 0 my $self = shift();
62 0 0       0 $self->{'Next'} = shift() if defined $_[0];
63 0         0 weaken $self->{'Next'};
64 0         0 return $self->{'Next'};
65             }
66              
67             # internal routine
68             sub first {
69 2     2 0 4 my $self = shift();
70              
71             $self->{'First'} = $self->{' children'}->[0]
72 2 100 66     31 if defined $self->{' children'} and defined $self->{' children'}->[0];
73 2         21 weaken $self->{'First'};
74 2         5 return $self->{'First'};
75             }
76              
77             # internal routine
78             sub last {
79 2     2 0 4 my $self = shift();
80              
81             $self->{'Last'} = $self->{' children'}->[-1]
82 2 100 66     11 if defined $self->{' children'} and defined $self->{' children'}->[-1];
83 2         7 weaken $self->{'Last'};
84 2         4 return $self->{'Last'};
85             }
86              
87             # internal routine
88             sub count {
89 3     3 0 8 my $self = shift();
90              
91 3 100       12 my $count = scalar @{$self->{' children'} || []};
  3         15  
92 3         7 $count += $_->count() for @{$self->{' children'}};
  3         9  
93 3 50       21 $self->{'Count'} = PDFNum($self->{' closed'}? -$count: $count) if $count > 0;
    100          
94 3         5 return $count;
95             }
96              
97             # internal routine
98             sub fix_outline {
99 2     2 0 5 my ($self) = @_;
100              
101 2         8 $self->first();
102 2         14 $self->last();
103 2         8 $self->count();
104 2         4 return;
105             }
106              
107             =item $outline->title($text)
108              
109             Set the title of the outline.
110              
111             =cut
112              
113             sub title {
114 1     1 1 5 my ($self, $text) = @_;
115 1         3 $self->{'Title'} = PDFString($text, 'o');
116 1         3 return $self;
117             }
118              
119             =item $outline->closed()
120              
121             Set the status of the outline to closed (i.e., collapsed).
122              
123             =cut
124              
125             sub closed {
126 0     0 1 0 my $self = shift();
127 0         0 $self->{' closed'} = 1;
128 0         0 return $self;
129             }
130              
131             =item $outline->open()
132              
133             Set the status of the outline to open (i.e., expanded).
134              
135             =cut
136              
137             sub open {
138 0     0 1 0 my $self = shift();
139 0         0 delete $self->{' closed'};
140 0         0 return $self;
141             }
142              
143             =item $child_outline = $parent_outline->outline()
144              
145             Returns a new sub-outline (nested outline).
146              
147             =cut
148              
149             sub outline {
150 1     1 1 9 my $self = shift();
151              
152 1         4 my $child = PDF::Builder::Outline->new($self->{' api'}, $self);
153 1 50       4 if (defined $self->{' children'}) {
154 0         0 $child->prev($self->{' children'}->[-1]);
155 0         0 $self->{' children'}->[-1]->next($child);
156             }
157 1         2 push @{$self->{' children'}}, $child;
  1         4  
158             $self->{' api'}->{'pdf'}->new_obj($child)
159 1 50       6 unless $child->is_obj($self->{' api'}->{'pdf'});
160              
161 1         3 return $child;
162             }
163              
164             =item $outline->dest($page_object, %position)
165              
166             =item $outline->dest($page_object)
167              
168             Sets the destination page and optional position of the outline.
169              
170             %position can be any of the following:
171              
172             =over
173              
174             =item -fit => 1
175              
176             Display the page designated by C<$page>, with its contents magnified just enough
177             to fit the entire page within the window both horizontally and vertically. If
178             the required horizontal and vertical magnification factors are different, use
179             the smaller of the two, centering the page within the window in the other
180             dimension.
181              
182             =item -fith => $top
183              
184             Display the page designated by C<$page>, with the vertical coordinate C<$top>
185             positioned at the top edge of the window and the contents of the page magnified
186             just enough to fit the entire width of the page within the window.
187              
188             =item -fitv => $left
189              
190             Display the page designated by C<$page>, with the horizontal coordinate C<$left>
191             positioned at the left edge of the window and the contents of the page magnified
192             just enough to fit the entire height of the page within the window.
193              
194             =item -fitr => [$left, $bottom, $right, $top]
195              
196             Display the page designated by C<$page>, with its contents magnified just enough
197             to fit the rectangle specified by the coordinates C<$left>, C<$bottom>,
198             C<$right>, and C<$top> entirely within the window both horizontally and
199             vertically. If the required horizontal and vertical magnification factors are
200             different, use the smaller of the two, centering the rectangle within the window
201             in the other dimension.
202              
203             =item -fitb => 1
204              
205             Display the page designated by C<$page>, with its contents magnified just
206             enough to fit its bounding box entirely within the window both horizontally and
207             vertically. If the required horizontal and vertical magnification factors are
208             different, use the smaller of the two, centering the bounding box within the
209             window in the other dimension.
210              
211             =item -fitbh => $top
212              
213             Display the page designated by C<$page>, with the vertical coordinate C<$top>
214             positioned at the top edge of the window and the contents of the page magnified
215             just enough to fit the entire width of its bounding box within the window.
216              
217             =item -fitbv => $left
218              
219             Display the page designated by C<$page>, with the horizontal coordinate C<$left>
220             positioned at the left edge of the window and the contents of the page
221             magnified just enough to fit the entire height of its bounding box within the
222             window.
223              
224             =item -xyz => [$left, $top, $zoom]
225              
226             Display the page designated by C<$page>, with the coordinates C<[$left, $top]>
227             positioned at the top-left corner of the window and the contents of the page
228             magnified by the factor C<$zoom>. A zero (0) value for any of the parameters
229             C<$left>, C<$top>, or C<$zoom> specifies that the current value of that
230             parameter is to be retained unchanged.
231              
232             This is the B fit setting, with position (left and top) and zoom
233             the same as the calling page's.
234              
235             =back
236              
237             =item $outline->dest($name, %position)
238              
239             =item $outline->dest($name)
240              
241             Connect the Outline to a "Named Destination" defined elsewhere,
242             and optional positioning as described above.
243              
244             =cut
245              
246             sub dest {
247 1     1 1 7 my ($self, $page, %position) = @_;
248 1         2 delete $self->{'A'};
249              
250 1 50       4 if (ref($page)) {
251 1         10 $self = $self->_fit($page, %position);
252             } else {
253 0         0 $self->{'Dest'} = PDFString($page, 'n');
254             }
255              
256 1         3 return $self;
257             }
258              
259             =item $outline->url($url)
260              
261             Defines the outline as launch-url with url C<$url>.
262              
263             =cut
264              
265             sub url {
266 0     0 1 0 my ($self, $url) = @_;
267              
268 0         0 delete $self->{'Dest'};
269 0         0 $self->{'A'} = PDFDict();
270 0         0 $self->{'A'}->{'S'} = PDFName('URI');
271 0         0 $self->{'A'}->{'URI'} = PDFString($url, 'u');
272              
273 0         0 return $self;
274             }
275              
276             =item $outline->file($file)
277              
278             Defines the outline as launch-file with filepath C<$file>.
279              
280             =cut
281              
282             sub file {
283 0     0 1 0 my ($self, $file) = @_;
284              
285 0         0 delete $self->{'Dest'};
286 0         0 $self->{'A'} = PDFDict();
287 0         0 $self->{'A'}->{'S'} = PDFName('Launch');
288 0         0 $self->{'A'}->{'F'} = PDFString($file, 'f');
289              
290 0         0 return $self;
291             }
292              
293             =item $outline->pdf_file($pdffile, $page_number, %position)
294              
295             =item $outline->pdf_file($pdffile, $page_number)
296              
297             Defines the destination of the outline as a PDF-file with filepath
298             C<$pdffile>, on page C<$pagenum> (default 0), and position C<%position>
299             (same as dest()).
300              
301             =cut
302              
303             sub pdf_file {
304 0     0 1 0 my ($self, $file, $page_number, %position) = @_;
305              
306 0         0 delete $self->{'Dest'};
307 0         0 $self->{'A'} = PDFDict();
308 0         0 $self->{'A'}->{'S'} = PDFName('GoToR');
309 0         0 $self->{'A'}->{'F'} = PDFString($file, 'f');
310 0   0     0 $self->{'A'}->{'D'} = $self->_fit(PDFNum($page_number // 0), %position);
311            
312 0         0 return $self;
313             }
314              
315             =back
316              
317             =cut
318              
319             # process destination, including position setting, with default of -xyz undef*3
320             sub _fit {
321 1     1   2 my ($self, $destination, %position) = @_;
322              
323 1 50       27 if (defined $position{'-fit'}) {
    50          
    50          
    50          
    50          
    50          
    50          
    50          
324 0         0 $self->{'Dest'} = PDFArray($destination, PDFName('Fit'));
325             } elsif (defined $position{'-fith'}) {
326 0         0 $self->{'Dest'} = PDFArray($destination, PDFName('FitH'), PDFNum($position{'-fith'}));
327             } elsif (defined $position{'-fitb'}) {
328 0         0 $self->{'Dest'} = PDFArray($destination, PDFName('FitB'));
329             } elsif (defined $position{'-fitbh'}) {
330 0         0 $self->{'Dest'} = PDFArray($destination, PDFName('FitBH'), PDFNum($position{'-fitbh'}));
331             } elsif (defined $position{'-fitv'}) {
332 0         0 $self->{'Dest'} = PDFArray($destination, PDFName('FitV'), PDFNum($position{'-fitv'}));
333             } elsif (defined $position{'-fitbv'}) {
334 0         0 $self->{'Dest'} = PDFArray($destination, PDFName('FitBV'), PDFNum($position{'-fitbv'}));
335             } elsif (defined $position{'-fitr'}) {
336 0 0       0 croak "Insufficient parameters to -fitr => []) " unless scalar @{$position{'-fitr'}} == 4;
  0         0  
337 0         0 $self->{'Dest'} = PDFArray($destination, PDFName('FitR'), map {PDFNum($_)} @{$position{'-fitr'}});
  0         0  
  0         0  
338             } elsif (defined $position{'-xyz'}) {
339 0 0       0 croak "Insufficient parameters to -xyz => []) " unless scalar @{$position{'-xyz'}} == 3;
  0         0  
340 0 0       0 $self->{'Dest'} = PDFArray($destination, PDFName('XYZ'), map {defined $_? PDFNum($_): PDFNull()} @{$position{'-xyz'}});
  0         0  
  0         0  
341             } else {
342             # no "fit" option found. use default.
343 1         4 $position{'-xyz'} = [undef,undef,undef];
344 1 50       3 $self->{'Dest'} = PDFArray($destination, PDFName('XYZ'), map {defined $_? PDFNum($_): PDFNull()} @{$position{'-xyz'}});
  3         9  
  1         3  
345             }
346              
347 1         4 return $self;
348             }
349              
350             #sub out_obj {
351             # my ($self, @param) = @_;
352             #
353             # $self->fix_outline();
354             # return $self->SUPER::out_obj(@param);
355             #}
356              
357             sub outobjdeep {
358             # my ($self, @param) = @_;
359             #
360             # $self->fix_outline();
361             # foreach my $k (qw/ api apipdf apipage /) {
362             # $self->{" $k"} = undef;
363             # delete($self->{" $k"});
364             # }
365             # my @ret = $self->SUPER::outobjdeep(@param);
366             # foreach my $k (qw/ First Parent Next Last Prev /) {
367             # $self->{$k} = undef;
368             # delete($self->{$k});
369             # }
370             # return @ret;
371 2     2 1 4 my $self = shift();
372 2         7 $self->fix_outline();
373 2         9 return $self->SUPER::outobjdeep(@_);
374             }
375              
376             1;