File Coverage

blib/lib/Text/PDF/Pages.pm
Criterion Covered Total %
statement 106 164 64.6
branch 30 84 35.7
condition 9 38 23.6
subroutine 15 21 71.4
pod 12 17 70.5
total 172 324 53.0


line stmt bran cond sub pod time code
1             package Text::PDF::Pages;
2              
3 1     1   3 use strict;
  1         1  
  1         22  
4 1     1   3 use vars qw(@ISA %inst);
  1         0  
  1         39  
5             @ISA = qw(Text::PDF::Dict);
6             # no warnings qw(uninitialized);
7              
8 1     1   3 use Text::PDF::Dict;
  1         1  
  1         12  
9 1     1   2 use Text::PDF::Utils;
  1         1  
  1         1383  
10              
11             %inst = map {$_ => 1} qw(Parent Type);
12              
13             =head1 NAME
14              
15             Text::PDF::Pages - a PDF pages hierarchical element. Inherits from L
16              
17             =head1 DESCRIPTION
18              
19             A Pages object is the parent to other pages objects or to page objects
20             themselves.
21              
22             =head1 METHODS
23              
24             =head2 Text::PDF::Pages->new($pdfs,$parent)
25              
26             This creates a new Pages object. Notice that $parent here is not the
27             file context for the object but the parent pages object for this
28             pages. If we are using this class to create a root node, then $parent
29             should point to the file context, which is identified by not having a
30             Type of Pages. $pdfs is the file object (or objects) in which to
31             create the new Pages object.
32              
33             =cut
34              
35             sub new
36             {
37 2     2 1 7 my ($class, $pdfs, $parent) = @_;
38 2         3 my ($self);
39              
40 2 50       3 $class = ref $class if ref $class;
41 2         7 $self = $class->SUPER::new($pdfs, $parent);
42 2         5 $self->{'Type'} = PDFName("Pages");
43 2 100       7 $self->{'Parent'} = $parent if defined $parent;
44 2         5 $self->{'Count'} = PDFNum(0);
45 2         6 $self->{'Kids'} = Text::PDF::Array->new;
46 2 50       5 $self->{' outto'} = ref $pdfs eq 'ARRAY' ? $pdfs : [$pdfs];
47 2         5 $self->out_obj(1);
48              
49 2         3 $self;
50             }
51              
52              
53             sub init
54             {
55 0     0 0 0 my ($self, $pdf) = @_;
56 0         0 $self->{' outto'} = [$pdf];
57 0         0 $self;
58             }
59              
60             =head2 $p->out_obj($isnew)
61              
62             Tells all the files that this thing is destined for that they should output this
63             object come time to output. If this object has no parent, then it must be the
64             root. So set as the root for the files in question and tell it to be output too.
65             If $isnew is set, then call new_obj rather than out_obj to create as a new
66             object in the file.
67              
68             =cut
69              
70             sub out_obj
71             {
72 4     4 1 5 my ($self, $isnew) = @_;
73              
74 4         1 foreach (@{$self->{' outto'}})
  4         8  
75             {
76 4 100       6 if ($isnew)
77 2         4 { $_->new_obj($self); }
78             else
79 2         4 { $_->out_obj($self); }
80            
81 4 100       8 unless (defined $self->{'Parent'})
82             {
83 3         4 $_->{'Root'}{'Pages'} = $self;
84 3         5 $_->out_obj($_->{'Root'});
85             }
86             }
87 4         5 $self;
88             }
89            
90              
91             =head2 $p->find_page($pnum)
92              
93             Returns the given page, using the page count values in the pages tree. Pages
94             start at 0.
95              
96             =cut
97              
98             sub find_page
99             {
100 1     1 1 2 my ($self, $pnum) = @_;
101 1         3 my ($top) = $self->get_top;
102            
103 1         2 $top->find_page_recurse(\$pnum);
104             }
105              
106              
107             sub find_page_recurse
108             {
109 1     1 0 2 my ($self, $rpnum) = @_;
110 1         1 my ($res, $k);
111            
112 1 50       4 if ($self->{'Count'}->realise->val <= $$rpnum)
113             {
114 0         0 $$rpnum -= $self->{'Count'}->val;
115 0         0 return undef;
116             }
117              
118 1         5 foreach $k ($self->{'Kids'}->realise->elementsof)
119             {
120 0 0       0 if ($k->{'Type'}->realise->val eq 'Page')
    0          
121             {
122 0 0       0 return $k if ($$rpnum == 0);
123 0         0 $$rpnum--;
124             }
125             elsif ($res = $k->realise->find_page_recurse($rpnum))
126 0         0 { return $res; }
127             }
128 1         3 return undef;
129             }
130            
131             =head2 $p->add_page($page, $pnum)
132              
133             Inserts the page before the given $pnum. $pnum can be -ve to count from the END
134             of the document. -1 is after the last page. Likewise $pnum can be greater than the
135             number of pages currently in the document, to append.
136              
137             This method only guarantees to provide a reasonable pages tree if pages are
138             appended or prepended to the document. Pages inserted in the middle of the
139             document may simply be inserted in the appropriate leaf in the pages tree without
140             adding any new branches or leaves. To tidy up such a mess, it is best to call
141             $p->rebuild_tree to rebuild the pages tree into something efficient.
142              
143             =cut
144              
145             sub add_page
146             {
147 1     1 1 2 my ($self, $page, $pnum) = @_;
148 1         2 my ($top) = $self->get_top;
149 1         2 my ($ppage, $ppages, $pindex, $ppnum);
150            
151 1 50 33     3 $pnum = -1 unless (defined $pnum && $pnum <= $top->{'Count'}->val);
152 1 50       2 if ($pnum == -1)
153 1         4 { $ppage = $top->find_page($top->{'Count'}->val - 1); }
154             else
155             {
156 0 0       0 $pnum = $top->{'Count'}->val + $pnum + 1 if ($pnum < 0);
157 0         0 $ppage = $top->find_page($pnum);
158             }
159            
160 1 50       3 if (defined $ppage->{'Parent'})
161 0         0 { $ppages = $ppage->{'Parent'}->realise; }
162             else
163 1         3 { $ppages = $self; }
164            
165 1         4 $ppnum = scalar $ppages->{'Kids'}->realise->elementsof;
166            
167 1 50       4 if ($pnum == -1)
168 1         2 { $pindex = -1; }
169             else
170             {
171 0         0 for ($pindex = 0; $pindex < $ppnum; $pindex++)
172 0 0       0 { last if ($ppages->{'Kids'}{' val'}[$pindex] eq $ppage); }
173 0 0       0 $pindex = -1 if ($pindex == $ppnum);
174             }
175            
176 1         9 $ppages->add_page_recurse($page->realise, $pindex);
177 1         3 for ($ppages = $page->{'Parent'}; defined $ppages->{'Parent'}; $ppages = $ppages->{'Parent'}->realise)
178 0         0 { $ppages->out_obj->{'Count'}->realise->{'val'}++; }
179 1         2 $ppages->out_obj->{'Count'}->realise->{'val'}++;
180 1         2 $page;
181             }
182              
183              
184             sub add_page_recurse
185             {
186 1     1 0 6 my ($self, $page, $index) = @_;
187 1         3 my ($newpages, $ppages, $pindex, $ppnum);
188            
189 1 50 33     3 if (scalar $self->{'Kids'}->elementsof >= 8 && $self->{'Parent'} && $index < 1)
      0        
190             {
191 0         0 $ppages = $self->{'Parent'}->realise;
192 0         0 $newpages = $self->new($self->{' outto'}, $ppages);
193 0 0       0 if ($ppages)
194             {
195 0         0 $ppnum = scalar $ppages->{'Kids'}->realise->elementsof;
196 0         0 for ($pindex = 0; $pindex < $ppnum; $pindex++)
197 0 0       0 { last if ($ppages->{'Kids'}{' val'}[$pindex] eq $self); }
198 0 0       0 $pindex = -1 if ($pindex == $ppnum);
199 0         0 $ppages->add_page_recurse($newpages, $pindex);
200             }
201             }
202             else
203 1         3 { $newpages = $self->out_obj; }
204            
205 1 50       4 if ($index < 0)
206 1         1 { push (@{$newpages->{'Kids'}->realise->{' val'}}, $page); }
  1         2  
207             else
208 0         0 { splice (@{$newpages->{'Kids'}{' val'}}, $index, 0, $page); }
  0         0  
209 1         2 $page->{'Parent'} = $newpages;
210             }
211              
212              
213             =head2 $root_pages = $p->rebuild_tree([@pglist])
214              
215             Rebuilds the pages tree to make a nice balanced tree that conforms to Adobe
216             recommendations. If passed a pglist then the tree is built for that list of
217             pages. No check is made of whether the pglist contains pages.
218              
219             Returns the top of the tree for insertion in the root object.
220              
221             =cut
222              
223             sub rebuild_tree
224             {
225 0     0 1 0 my ($self, @pglist) = @_;
226             }
227              
228              
229             =head2 @pglist = $p->get_pages
230              
231             Returns a list of page objects in the document in page order
232              
233             =cut
234              
235             sub get_pages
236             {
237 0     0 1 0 my ($self) = @_;
238            
239 0         0 return $self->get_top->get_kids;
240             }
241              
242              
243             # only call this on the top level or anything you want pages below
244             sub get_kids
245             {
246 0     0 0 0 my ($self) = @_;
247 0         0 my ($pgref, @pglist);
248              
249 0         0 foreach $pgref ($self->{'Kids'}->elementsof)
250             {
251 0         0 $pgref->realise;
252 0 0       0 if ($pgref->{'Type'}->val =~ m/^Pages$/oi)
253 0         0 { push (@pglist, $pgref->get_kids()); }
254             else
255 0         0 { push (@pglist, $pgref); }
256             }
257 0         0 @pglist;
258             }
259              
260             =head2 $p->find_prop($key)
261              
262             Searches up through the inheritance tree to find a property.
263              
264             =cut
265              
266             sub find_prop
267             {
268 3     3 1 3 my ($self, $prop) = @_;
269              
270 3 100       13 if (defined $self->{$prop})
    50          
271             {
272 1 50 33     10 if (ref $self->{$prop} && $self->{$prop}->isa("Text::PDF::Objind"))
273 1         8 { return $self->{$prop}->realise; }
274             else
275 0         0 { return $self->{$prop}; }
276             } elsif (defined $self->{'Parent'})
277 0         0 { return $self->{'Parent'}->find_prop($prop); }
278             }
279              
280             # defined $_[0]->{$_[1]} && $_[0]->{$_[1]}->realised or
281             # defined $_[0]->{'Parent'} && $_[0]->{'Parent'}->find_prop($_[1]); }
282              
283              
284             =head2 $p->add_font($pdf, $font)
285              
286             Creates or edits the resource dictionary at this level in the hierarchy. If
287             the font is already supported even through the hierarchy, then it is not added.
288              
289             =cut
290              
291             sub add_font
292             {
293 1     1 1 4 my ($self, $font, $pdf) = @_;
294 1         4 my ($name) = $font->{'Name'}->val;
295 1         3 my ($dict) = $self->find_prop('Resources');
296 1         1 my ($rdict);
297              
298 1 50 33     8 return $self if ($dict ne "" && defined $dict->{'Font'} && defined $dict->{'Font'}{$name});
      33        
299 1 50       5 unless (defined $self->{'Resources'})
300             {
301 0 0       0 $dict = $dict ne "" ? $dict->copy($pdf) : PDFDict();
302 0         0 $self->{'Resources'} = $dict;
303             }
304             else
305 1         1 { $dict = $self->{'Resources'}; }
306 1 50       4 $dict->{'Font'} = PDFDict() unless defined $self->{'Resources'}{'Font'};
307 1         4 $rdict = $dict->{'Font'}->val;
308 1 50       3 $rdict->{$name} = $font unless ($rdict->{$name});
309 1 50 33     5 if (ref $dict ne 'HASH' && $dict->is_obj($pdf))
310 0         0 { $pdf->out_obj($dict); }
311 1 50 33     8 if (ref $rdict ne 'HASH' && $rdict->is_obj($pdf))
312 0         0 { $pdf->out_obj($rdict); }
313 1         3 $self;
314             }
315              
316              
317             =head2 $p->bbox($xmin, $ymin, $xmax, $ymax, [$param])
318              
319             Specifies the bounding box for this and all child pages. If the values are
320             identical to those inherited then no change is made. $param specifies the attribute
321             name so that other 'bounding box'es can be set with this method.
322              
323             =cut
324              
325             sub bbox
326             {
327 1     1 1 4 my ($self, @bbox) = @_;
328 1   50     8 my ($str) = $bbox[4] || 'MediaBox';
329 1         3 my ($inh) = $self->find_prop($str);
330 1         1 my ($test, $i, $e);
331              
332 1 50       3 if ($inh ne "")
333             {
334 0         0 $test = 1; $i = 0;
  0         0  
335 0         0 foreach $e ($inh->elementsof)
336 0   0     0 { $test &&= $e->val == $bbox[$i++]; }
337 0 0 0     0 return $self if $test && $i == 4;
338             }
339              
340 1         3 $inh = Text::PDF::Array->new;
341 1         3 foreach $e (@bbox[0..3])
342 4         6 { $inh->add_elements(PDFNum($e)); }
343 1         3 $self->{$str} = $inh;
344 1         2 $self;
345             }
346              
347              
348             =head2 $p->proc_set(@entries)
349              
350             Ensures that the current resource contains all the entries in the proc_sets
351             listed. If necessary it creates a local resource dictionary to achieve this.
352              
353             =cut
354              
355             sub proc_set
356             {
357 1     1 1 4 my ($self, @entries) = @_;
358 1         2 my (@temp) = @entries;
359 1         1 my ($dict, $e);
360              
361 1         2 $dict = $self->find_prop('Resource');
362 1 50 33     4 if ($dict ne "" && defined $dict->{'ProcSet'})
363             {
364 0         0 foreach $e ($dict->{'ProcSet'}->elementsof)
365 0         0 { @temp = grep($_ ne $e, @temp); }
366 0 0       0 return $self if (scalar @temp == 0);
367 0 0       0 @entries = @temp if defined $self->{'Resources'};
368             }
369              
370 1 50       3 unless (defined $self->{'Resources'})
371 1 50       3 { $self->{'Resources'} = $dict ne "" ? $dict->copy : PDFDict(); }
372              
373 1 50       5 $self->{'Resources'}{'ProcSet'} = PDFArray() unless defined $self->{'ProcSet'};
374              
375 1         2 foreach $e (@entries)
376 2         4 { $self->{'Resources'}{'ProcSet'}->add_elements(PDFName($e)); }
377 1         2 $self;
378             }
379              
380             sub empty
381             {
382 0     0 1 0 my ($self) = @_;
383 0 0       0 my ($parent) = $self->{'Parent'} if defined ($self->{'Parent'});
384              
385 0         0 $self->SUPER::empty;
386 0 0       0 $self->{'Parent'} = $parent if defined $parent;
387 0         0 $self;
388             }
389              
390             sub dont_copy
391 0   0 0 0 0 { return $inst{$_[1]} || $_[0]->SUPER::dont_copy($_[1]); }
392              
393              
394             =head2 $p->get_top
395              
396             Returns the top of the pages tree
397              
398             =cut
399              
400             sub get_top
401             {
402 2     2 1 3 my ($self) = @_;
403 2         1 my ($p);
404            
405 2         6 for ($p = $self; defined $p->{'Parent'}; $p = $p->{'Parent'})
406             { }
407            
408 2         6 $p->realise;
409             }
410              
411              
412             1;