File Coverage

blib/lib/Text/PDF/Objind.pm
Criterion Covered Total %
statement 31 71 43.6
branch 11 34 32.3
condition 1 15 6.6
subroutine 8 15 53.3
pod 12 13 92.3
total 63 148 42.5


line stmt bran cond sub pod time code
1             package Text::PDF::Objind;
2              
3             =head1 NAME
4              
5             Text::PDF::Objind - PDF indirect object reference. Also acts as an abstract
6             superclass for all elements in a PDF file.
7              
8             =head1 INSTANCE VARIABLES
9              
10             Instance variables differ from content variables in that they all start with
11             a space.
12              
13             =over
14              
15             =item parent
16              
17             For an object which is a reference to an object in some source, this holds the
18             reference to the source object, so that should the reference have to be
19             de-referenced, then we know where to go and get the info.
20              
21             =item objnum (R)
22              
23             The object number in the source (only for object references)
24              
25             =item objgen (R)
26              
27             The object generation in the source
28              
29             There are other instance variables which are used by the parent for file control.
30              
31             =item isfree
32              
33             This marks whether the object is in the free list and available for re-use as
34             another object elsewhere in the file.
35              
36             =item nextfree
37              
38             Holds a direct reference to the next free object in the free list.
39              
40             =back
41              
42             =head1 METHODS
43              
44             =cut
45              
46 1     1   3 use strict;
  1         1  
  1         26  
47 1     1   4 use vars qw(@inst %inst $uidc);
  1         1  
  1         715  
48             # no warnings qw(uninitialized);
49              
50             # protected keys during emptying and copying, etc.
51              
52             @inst = qw(parent objnum objgen isfree nextfree uid);
53             map {$inst{" $_"} = 1} @inst;
54             $uidc = "pdfuid000";
55              
56              
57             =head2 Text::PDF::Objind->new()
58              
59             Creates a new indirect object
60              
61             =cut
62              
63             sub new
64             {
65 11     11 1 12 my ($class) = @_;
66 11         12 my ($self) = {};
67              
68 11   33     43 bless $self, ref $class || $class;
69             }
70              
71             =head2 uid
72              
73             Returns a Unique id for this object, creating one if it didn't have one before
74              
75             =cut
76              
77             sub uid
78 129 100   129 1 408 { $_[0]->{' uid'} || ($_[0]->{' uid'} = $uidc++); }
79              
80             =head2 $r->release
81              
82             Releases ALL of the memory used by this indirect object, and all of its
83             component/child objects. This method is called automatically by
84             'Crelease>' (so you don't have to call it yourself).
85              
86             B, that it is important that this method get called at some point prior
87             to the actual destruction of the object. Internally, PDF files have an
88             enormous amount of cross-references and this causes circular references within
89             our own internal data structures. Calling 'C' forces these circular
90             references to be cleaned up and the entire internal data structure purged.
91              
92             B As part of the brute-force cleanup done here, this method
93             will throw a warning message whenever unexpected key values are found within
94             the C object. This is done to help ensure that unexpected
95             and unfreed values are brought to your attention, so you can bug us to keep the
96             module updated properly; otherwise the potential for memory leaks due to
97             dangling circular references will exist.
98              
99             =cut
100              
101             sub release
102             {
103 35     35 1 30 my ($self, $force) = @_;
104 35         24 my (@tofree);
105              
106             # delete stuff that we know we can, here
107              
108 35 50       26 if ($force)
109             {
110 0         0 foreach my $key (keys %{$self})
  0         0  
111             {
112 0         0 push(@tofree,$self->{$key});
113 0         0 $self->{$key}=undef;
114 0         0 delete($self->{$key});
115             }
116             }
117             else
118 35         26 { @tofree = map { delete $self->{$_} } keys %{$self}; }
  100         92  
  35         45  
119              
120 35         57 while (my $item = shift @tofree)
121             {
122 103         84 my $ref = ref($item);
123 103 100       280 if (UNIVERSAL::can($ref, 'release')) # $ref was $item
    100          
    50          
124 30         42 { $item->release($force); }
125             elsif ($ref eq 'ARRAY')
126 6         4 { push( @tofree, @{$item} ); }
  6         14  
127             elsif (UNIVERSAL::isa($ref, 'HASH'))
128 0         0 { release($item, $force); }
129             }
130              
131             # check that everything has gone - it better had!
132 35         21 foreach my $key (keys %{$self})
  35         84  
133 0         0 { warn ref($self) . " still has '$key' key left after release.\n"; }
134             }
135              
136              
137             =head2 $r->val
138              
139             Returns the val of this object or reads the object and then returns its value.
140              
141             Note that all direct subclasses *must* make their own versions of this subroutine
142             otherwise we could be in for a very deep loop!
143              
144             =cut
145              
146             sub val
147             {
148 0     0 1 0 my ($self) = @_;
149            
150 0 0       0 $self->{' parent'}->read_obj(@_)->val unless ($self->{' realised'});
151             }
152              
153             =head2 $r->realise
154              
155             Makes sure that the object is fully read in, etc.
156              
157             =cut
158              
159             sub realise
160 9 50   9 1 40 { $_[0]->{' realised'} ? $_[0] : $_[0]->{' parent'}->read_obj(@_); }
161              
162             =head2 $r->outobjdeep($fh, $pdf)
163              
164             If you really want to output this object, then you must need to read it first.
165             This also means that all direct subclasses must subclass this method or loop forever!
166              
167             =cut
168              
169             sub outobjdeep
170             {
171 0     0 1 0 my ($self, $fh, $pdf, %opts) = @_;
172              
173 0 0       0 $self->{' parent'}->read_obj($self)->outobjdeep($fh, $pdf) unless ($self->{' realised'});
174             }
175              
176              
177             =head2 $r->outobj($fh)
178              
179             If this is a full object then outputs a reference to the object, otherwise calls
180             outobjdeep to output the contents of the object at this point.
181              
182             =cut
183              
184             sub outobj
185             {
186 28     28 1 41 my ($self, $fh, $pdf, %opts) = @_;
187              
188 28 100       34 if (defined $pdf->{' objects'}{$self->uid})
189 6         6 { $fh->printf("%d %d R", @{$pdf->{' objects'}{$self->uid}}[0..1]); }
  6         8  
190             else
191 22         59 { $self->outobjdeep($fh, $pdf, %opts); }
192             }
193              
194              
195             =head2 $r->elementsof
196              
197             Abstract superclass function filler. Returns self here but should return
198             something more useful if an array.
199              
200             =cut
201              
202             sub elementsof
203             {
204 0     0 1 0 my ($self) = @_;
205              
206 0 0       0 if ($self->{' realised'})
207 0         0 { return ($self); }
208             else
209 0         0 { return $self->{' parent'}->read_obj($self)->elementsof; }
210             }
211              
212              
213             =head2 $r->empty
214              
215             Empties all content from this object to free up memory or to be read to pass
216             the object into the free list. Simplistically undefs all instance variables
217             other than object number and generation.
218              
219             =cut
220              
221             sub empty
222             {
223 0     0 1 0 my ($self) = @_;
224 0         0 my ($k);
225              
226 0         0 for $k (keys %$self)
227 0 0       0 { undef $self->{$k} unless $self->dont_copy($k); }
228 0         0 $self;
229             }
230              
231              
232             =head2 $r->merge($objind)
233              
234             This merges content information into an object reference place-holder.
235             This occurs when an object reference is read before the object definition
236             and the information in the read data needs to be merged into the object
237             place-holder
238              
239             =cut
240              
241             sub merge
242             {
243 0     0 1 0 my ($self, $other) = @_;
244 0         0 my ($k);
245              
246 0         0 for $k (keys %$other)
247 0 0       0 { $self->{$k} = $other->{$k} unless $self->dont_copy($k); }
248 0         0 $self->{' realised'} = 1;
249 0         0 bless $self, ref($other);
250             }
251              
252              
253             =head2 $r->is_obj($pdf)
254              
255             Returns whether this object is a full object with its own object number or
256             whether it is purely a sub-object. $pdf indicates which output file we are
257             concerned that the object is an object in.
258              
259             =cut
260              
261             sub is_obj
262 12     12 1 23 { defined $_[1]->{' objects'}{$_[0]->uid}; }
263              
264              
265             =head2 $r->copy($inpdf, $res, $unique, $outpdf, %opts)
266              
267             Returns a new copy of this object.
268              
269             $inpdf gives the source pdf object for the object to be copied. $outpdf gives the
270             target pdf for the object to be copied into. $outpdf may be undefined. $res may be
271             defined in which case the object is copied into that object. $unique controls
272             recursion. if $unique is non zero then new objects are always created and recursion
273             always occurs. But each time recursion occurs, $unique is incremented. Thus is $unique
274             starts with a negative value it is possible to stop the recursion at a certain depth. Of
275             course for a positive value of $unique, recursion always occurs.
276              
277             If $unique is 0 then recursion only occurs if $outpdf is not the same as $inpdf. In this
278             case, a cache is held in $outpdf to see whether a previous copy of the same object has
279             been made. If so, then that previous copy is returned otherwise a new object is made and
280             added to the cache and recursed into.
281              
282             Objects that are full objects with their own id numbers are correspondingly full objects
283             in the output pdf.
284              
285             =cut
286              
287             sub copy
288             {
289 0     0 1   my ($self, $inpdf, $res, $unique, $outpdf, %opts) = @_;
290 0           my ($k, $o);
291              
292 0 0         $outpdf = $inpdf unless $outpdf;
293 0           $self->realise;
294 0 0         unless (defined $res)
295             {
296 0 0 0       if ($outpdf eq $inpdf && !$unique)
    0 0        
297 0           { return $self; }
298             elsif (!$unique && defined $outpdf->{' copies'}{$self->uid})
299 0           { return $outpdf->{' copies'}{$self->uid}; }
300              
301 0           $res = {};
302 0           bless $res, ref($self);
303             }
304              
305 0 0 0       if ($self->is_obj($inpdf) && ($unique || ($outpdf ne $inpdf && !defined $outpdf->{' copies'}{$self->uid})))
      0        
306             {
307 0           $outpdf->new_obj($res);
308             # $outpdf->{' copies'}{$self->uid} = $res unless ($unique);
309             }
310            
311 0           $res;
312             }
313              
314              
315              
316             sub dont_copy
317 0     0 0   { return $inst{$_[1]}; }
318              
319             1;
320