« back to all changes in this revision
Viewing changes to lib/Text/PDF/Pages.pm
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Bazaar Package Importer
- Author(s): Gunnar Wolf
- Date: 2003-06-19 13:37:58 UTC
- Revision ID: james.westby@ubuntu.com-20030619133758-6qa8nc1qryh9fv33
Tags: upstream-0.25
Import upstream version 0.25
- files added:
- examples
- lib
- lib/Text
- lib/Text/PDF
- scripts
added
removed
lib/Text/PDF/Pages.pm
1
package Text::PDF::Pages;
2
3
use strict;
4
use vars qw(@ISA %inst);
5
@ISA = qw(Text::PDF::Dict);
6
# no warnings qw(uninitialized);
7
8
use Text::PDF::Dict;
9
use Text::PDF::Utils;
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<Text::PDF::Dict>
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
my ($class, $pdfs, $parent) = @_;
38
my ($self);
39
40
$class = ref $class if ref $class;
41
$self = $class->SUPER::new($pdfs, $parent);
42
$self->{'Type'} = PDFName("Pages");
43
$self->{'Parent'} = $parent if defined $parent;
44
$self->{'Count'} = PDFNum(0);
45
$self->{'Kids'} = Text::PDF::Array->new;
46
$self->{' outto'} = ref $pdfs eq 'ARRAY' ? $pdfs : [$pdfs];
47
$self->out_obj(1);
48
49
$self;
50
}
51
52
53
sub init
54
{
55
my ($self, $pdf) = @_;
56
$self->{' outto'} = [$pdf];
57
$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
my ($self, $isnew) = @_;
73
74
foreach (@{$self->{' outto'}})
75
{
76
if ($isnew)
77
{ $_->new_obj($self); }
78
else
79
{ $_->out_obj($self); }
80
81
unless (defined $self->{'Parent'})
82
{
83
$_->{'Root'}{'Pages'} = $self;
84
$_->out_obj($_->{'Root'});
85
}
86
}
87
$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
my ($self, $pnum) = @_;
101
my ($top) = $self->get_top;
102
103
$top->find_page_recurse(\$pnum);
104
}
105
106
107
sub find_page_recurse
108
{
109
my ($self, $rpnum) = @_;
110
my ($res, $k);
111
112
if ($self->{'Count'}->realise->val <= $$rpnum)
113
{
114
$$rpnum -= $self->{'Count'}->val;
115
return undef;
116
}
117
118
foreach $k ($self->{'Kids'}->realise->elementsof)
119
{
120
if ($k->{'Type'}->realise->val eq 'Page')
121
{
122
return $k if ($$rpnum == 0);
123
$$rpnum--;
124
}
125
elsif ($res = $k->realise->find_page_recurse($rpnum))
126
{ return $res; }
127
}
128
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
my ($self, $page, $pnum) = @_;
148
my ($top) = $self->get_top;
149
my ($ppage, $ppages, $pindex, $ppnum);
150
151
$pnum = -1 unless (defined $pnum && $pnum <= $top->{'Count'}->val);
152
if ($pnum == -1)
153
{ $ppage = $top->find_page($top->{'Count'}->val - 1); }
154
else
155
{
156
$pnum = $top->{'Count'}->val + $pnum + 1 if ($pnum < 0);
157
$ppage = $top->find_page($pnum);
158
}
159
160
if (defined $ppage->{'Parent'})
161
{ $ppages = $ppage->{'Parent'}->realise; }
162
else
163
{ $ppages = $self; }
164
165
$ppnum = scalar $ppages->{'Kids'}->realise->elementsof;
166
167
if ($pnum == -1)
168
{ $pindex = -1; }
169
else
170
{
171
for ($pindex = 0; $pindex < $ppnum; $pindex++)
172
{ last if ($ppages->{'Kids'}{' val'}[$pindex] eq $ppage); }
173
$pindex = -1 if ($pindex == $ppnum);
174
}
175
176
$ppages->add_page_recurse($page->realise, $pindex);
177
for ($ppages = $page->{'Parent'}; defined $ppages->{'Parent'}; $ppages = $ppages->{'Parent'}->realise)
178
{ $ppages->out_obj->{'Count'}->realise->{'val'}++; }
179
$ppages->out_obj->{'Count'}->realise->{'val'}++;
180
$page;
181
}
182
183
184
sub add_page_recurse
185
{
186
my ($self, $page, $index) = @_;
187
my ($newpages, $ppages, $pindex, $ppnum);
188
189
if (scalar $self->{'Kids'}->elementsof >= 8 && $self->{'Parent'} && $index < 1)
190
{
191
$ppages = $self->{'Parent'}->realise;
192
$newpages = $self->new($self->{' outto'}, $ppages);
193
if ($ppages)
194
{
195
$ppnum = scalar $ppages->{'Kids'}->realise->elementsof;
196
for ($pindex = 0; $pindex < $ppnum; $pindex++)
197
{ last if ($ppages->{'Kids'}{' val'}[$pindex] eq $self); }
198
$pindex = -1 if ($pindex == $ppnum);
199
$ppages->add_page_recurse($newpages, $pindex);
200
}
201
}
202
else
203
{ $newpages = $self->out_obj; }
204
205
if ($index < 0)
206
{ push (@{$newpages->{'Kids'}->realise->{' val'}}, $page); }
207
else
208
{ splice (@{$newpages->{'Kids'}{' val'}}, $index, 0, $page); }
209
$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
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
my ($self) = @_;
238
239
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
my ($self) = @_;
247
my ($pgref, @pglist);
248
249
foreach $pgref ($self->{'Kids'}->elementsof)
250
{
251
$pgref->realise;
252
if ($pgref->{'Type'}->val =~ m/^Pages$/oi)
253
{ push (@pglist, proc_pages($pgref)); }
254
else
255
{ push (@pglist, $pgref); }
256
}
257
@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
my ($self, $prop) = @_;
269
270
if (defined $self->{$prop})
271
{
272
if (ref $self->{$prop} && $self->{$prop}->isa("Text::PDF::Objind"))
273
{ return $self->{$prop}->realise; }
274
else
275
{ return $self->{$prop}; }
276
} elsif (defined $self->{'Parent'})
277
{ 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
my ($self, $font, $pdf) = @_;
294
my ($name) = $font->{'Name'}->val;
295
my ($dict) = $self->find_prop('Resources');
296
my ($rdict);
297
298
return $self if ($dict ne "" && defined $dict->{'Font'} && defined $dict->{'Font'}{$name});
299
unless (defined $self->{'Resources'})
300
{
301
$dict = $dict ne "" ? $dict->copy($pdf) : PDFDict();
302
$self->{'Resources'} = $dict;
303
}
304
else
305
{ $dict = $self->{'Resources'}; }
306
$dict->{'Font'} = PDFDict() unless defined $self->{'Resources'}{'Font'};
307
$rdict = $dict->{'Font'}->val;
308
$rdict->{$name} = $font unless ($rdict->{$name});
309
if (ref $dict ne 'HASH' && $dict->is_obj($pdf))
310
{ $pdf->out_obj($dict); }
311
if (ref $rdict ne 'HASH' && $rdict->is_obj($pdf))
312
{ $pdf->out_obj($rdict); }
313
$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
my ($self, @bbox) = @_;
328
my ($str) = $bbox[4] || 'MediaBox';
329
my ($inh) = $self->find_prop($str);
330
my ($test, $i, $e);
331
332
if ($inh ne "")
333
{
334
$test = 1; $i = 0;
335
foreach $e ($inh->elementsof)
336
{ $test &= $e->val == $bbox[$i++]; }
337
return $self if $test && $i == 4;
338
}
339
340
$inh = Text::PDF::Array->new;
341
foreach $e (@bbox[0..3])
342
{ $inh->add_elements(PDFNum($e)); }
343
$self->{$str} = $inh;
344
$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
my ($self, @entries) = @_;
358
my (@temp) = @entries;
359
my ($dict, $e);
360
361
$dict = $self->find_prop('Resource');
362
if ($dict ne "" && defined $dict->{'ProcSet'})
363
{
364
foreach $e ($dict->{'ProcSet'}->elementsof)
365
{ @temp = grep($_ ne $e, @temp); }
366
return $self if (scalar @temp == 0);
367
@entries = @temp if defined $self->{'Resources'};
368
}
369
370
unless (defined $self->{'Resources'})
371
{ $self->{'Resources'} = $dict ne "" ? $dict->copy : PDFDict(); }
372
373
$self->{'Resources'}{'ProcSet'} = PDFArray() unless defined $self->{'ProcSet'};
374
375
foreach $e (@entries)
376
{ $self->{'Resources'}{'ProcSet'}->add_elements(PDFName($e)); }
377
$self;
378
}
379
380
sub empty
381
{
382
my ($self) = @_;
383
my ($parent) = $self->{'Parent'} if defined ($self->{'Parent'});
384
385
$self->SUPER::empty;
386
$self->{'Parent'} = $parent if defined $parent;
387
$self;
388
}
389
390
sub dont_copy
391
{ 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
my ($self) = @_;
403
my ($p);
404
405
for ($p = $self; defined $p->{'Parent'}; $p = $p->{'Parent'})
406
{ }
407
408
$p->realise;
409
}
410
411
412
1;
Loggerhead is a web-based interface for Breezy
Version: 2.0.1