File Coverage

blib/lib/PDF/Builder/Basic/PDF/Dict.pm
Criterion Covered Total %
statement 121 151 80.1
branch 52 82 63.4
condition 26 36 72.2
subroutine 13 14 92.8
pod 6 7 85.7
total 218 290 75.1


line stmt bran cond sub pod time code
1             #=======================================================================
2             #
3             # THIS IS A REUSED PERL MODULE, FOR PROPER LICENCING TERMS SEE BELOW:
4             #
5             # Copyright Martin Hosken
6             #
7             # No warranty or expression of effectiveness, least of all regarding
8             # anyone's safety, is implied in this software or documentation.
9             #
10             # This specific module is licensed under the Perl Artistic License.
11             # Effective 28 January 2021, the original author and copyright holder,
12             # Martin Hosken, has given permission to use and redistribute this module
13             # under the MIT license.
14             #
15             #=======================================================================
16             package PDF::Builder::Basic::PDF::Dict;
17              
18 37     37   271 use base 'PDF::Builder::Basic::PDF::Objind';
  37         77  
  37         4037  
19              
20 37     37   236 use strict;
  37         89  
  37         749  
21 37     37   175 use warnings;
  37         65  
  37         2620  
22             #no warnings qw[ deprecated recursion uninitialized ];
23              
24             our $VERSION = '3.023'; # VERSION
25             our $LAST_UPDATE = '3.022'; # manually update whenever code is changed
26              
27             our $mincache = 16 * 1024 * 1024;
28              
29 37     37   28220 use File::Temp;
  37         522719  
  37         3008  
30 37     37   320 use PDF::Builder::Basic::PDF::Array;
  37         80  
  37         866  
31 37     37   17636 use PDF::Builder::Basic::PDF::Filter;
  37         127  
  37         1313  
32 37     37   17972 use PDF::Builder::Basic::PDF::Name;
  37         100  
  37         61779  
33              
34             =head1 NAME
35              
36             PDF::Builder::Basic::PDF::Dict - PDF Dictionaries and Streams. Inherits from
37             L
38              
39             =head1 INSTANCE VARIABLES
40              
41             There are various special instance variables which are used to look after,
42             particularly, streams. Each begins with a space:
43              
44             =over
45              
46             =item ' stream'
47              
48             Holds the stream contents for output
49              
50             =item ' streamfile'
51              
52             Holds the stream contents in an external file rather than in memory. This is
53             not the same as a PDF file stream. The data is stored in its unfiltered form.
54              
55             =item ' streamloc'
56              
57             If both ' stream' and ' streamfile' are empty, this indicates where in the
58             source PDF the stream starts.
59              
60             =back
61              
62             =head1 METHODS
63              
64             =cut
65              
66             sub new {
67 1543     1543 1 3264 my ($class) = @_;
68              
69 1543 50       3514 $class = ref($class) if ref($class);
70              
71 1543         5199 my $self = $class->SUPER::new(@_);
72 1543         4377 $self->{' realised'} = 1;
73 1543         4107 return $self;
74             }
75              
76             =head2 $type = $d->type($type)
77              
78             Get/Set the standard Type key. It can be passed, and will return, a text value rather than a Name object.
79              
80             =cut
81              
82             sub type {
83 24     24 1 47 my $self = shift();
84 24 50       74 if (scalar @_) {
85 24         48 my $type = shift();
86 24 50       145 $self->{'Type'} = ref($type)? $type: PDF::Builder::Basic::PDF::Name->new($type);
87             }
88 24 50       78 return unless exists $self->{'Type'};
89 24         76 return $self->{'Type'}->val();
90             }
91              
92             =head2 @filters = $d->filter(@filters)
93              
94             Get/Set one or more filters being used by the optional stream attached to the dictionary.
95              
96             =cut
97              
98             sub filter {
99 9     9 1 28 my ($self, @filters) = @_;
100              
101             # Developer's Note: the PDF specification allows Filter to be
102             # either a name or an array, but other parts of this codebase
103             # expect an array. If these are updated, uncomment the
104             # commented-out lines in order to accept both types.
105              
106             # if (scalar @filters == 1) {
107             # $self->{'Filter'} = ref($filters[0])? $filters[0]: PDF::Builder::Basic::PDF::Name->new($filters[0]);
108             # } elsif (scalar @filters) {
109 9 50       28 @filters = map { ref($_)? $_: PDF::Builder::Basic::PDF::Name->new($_) } @filters;
  9         44  
110 9         52 $self->{'Filter'} = PDF::Builder::Basic::PDF::Array->new(@filters);
111             # }
112 9         26 return $self->{'Filter'};
113             }
114              
115             # Undocumented alias, which may be removed in a future release
116 9     9 0 43 sub filters { return filter(@_); }
117              
118             =head2 $d->outobjdeep($fh, $pdf)
119              
120             Outputs the contents of the dictionary to a PDF file. This is a recursive call.
121              
122             It also outputs a stream if the dictionary has a stream element. If this occurs
123             then this method will calculate the length of the stream and insert it into the
124             stream's dictionary.
125              
126             =cut
127              
128             sub outobjdeep {
129 1169     1169 1 2340 my ($self, $fh, $pdf) = @_;
130              
131 1169 100 100     5887 if (defined $self->{' stream'} or defined $self->{' streamfile'} or defined $self->{' streamloc'}) {
      66        
132 119 100 100     805 if ($self->{'Filter'} and $self->{' nofilt'}) {
    100 66        
133 8   66     72 $self->{'Length'} ||= PDF::Builder::Basic::PDF::Number->new(length($self->{' stream'}));
134             } elsif ($self->{'Filter'} or not defined $self->{' stream'}) {
135 10 50       92 $self->{'Length'} = PDF::Builder::Basic::PDF::Number->new(0) unless defined $self->{'Length'};
136 10 50       85 $pdf->new_obj($self->{'Length'}) unless $self->{'Length'}->is_obj($pdf);
137             } else {
138 101         451 $self->{'Length'} = PDF::Builder::Basic::PDF::Number->new(length($self->{' stream'}));
139             }
140             }
141              
142 1169         3134 $fh->print('<< ');
143 1169         10884 foreach my $key (sort {
144 24262 100       56416 $a eq 'Type' ? -1: $b eq 'Type' ? 1:
    100          
    100          
    100          
145             $a eq 'Subtype'? -1: $b eq 'Subtype'? 1: $a cmp $b
146             } keys %$self) {
147 9272 100       29985 next if $key =~ m/^[\s\-]/o;
148 3080 50       6659 next unless $self->{$key};
149 3080         7558 $fh->print('/' . PDF::Builder::Basic::PDF::Name::string_to_name($key, $pdf) . ' ');
150 3080         23075 $self->{$key}->outobj($fh, $pdf);
151 3080         5799 $fh->print(' ');
152             }
153 1169         8042 $fh->print('>>');
154              
155             # Now handle the stream (if any)
156 1169         5859 my (@filters, $loc);
157              
158 1169 50 33     2846 if (defined $self->{' streamloc'} and not defined $self->{' stream'}) {
159             # read a stream if in file
160 0         0 $loc = $fh->tell();
161 0         0 $self->read_stream();
162 0         0 $fh->seek($loc, 0);
163             }
164              
165 1169 50 100     4226 if (not $self->{' nofilt'} and defined $self->{'Filter'} and (defined $self->{' stream'} or defined $self->{' streamfile'})) {
      33        
      66        
166 10         24 my $hasflate = -1;
167 10         22 for my $i (0 .. scalar(@{$self->{'Filter'}{' val'}}) - 1) {
  10         61  
168 10         66 my $filter = $self->{'Filter'}{' val'}[$i]->val();
169             # hack to get around LZW patent
170 10 50       114 if ($filter eq 'LZWDecode') {
    100          
171 0 0       0 if ($hasflate < -1) {
172 0         0 $hasflate = $i;
173 0         0 next;
174             }
175 0         0 $filter = 'FlateDecode';
176 0         0 $self->{'Filter'}{' val'}[$i]{'val'} = $filter; # !!!
177             } elsif ($filter eq 'FlateDecode') {
178 9         25 $hasflate = -2;
179             }
180 10         42 my $filter_class = "PDF::Builder::Basic::PDF::Filter::$filter";
181 10         138 push (@filters, $filter_class->new());
182             }
183 10 50       54 splice(@{$self->{'Filter'}{' val'}}, $hasflate, 1) if $hasflate > -1;
  0         0  
184             }
185              
186 1169 100       2948 if (defined $self->{' stream'}) {
    100          
187 118         384 $fh->print("\nstream\n");
188 118         801 $loc = $fh->tell();
189 118         696 my $stream = $self->{' stream'};
190 118 100       323 unless ($self->{' nofilt'}) {
191 111         289 foreach my $filter (reverse @filters) {
192 10         54 $stream = $filter->outfilt($stream, 1);
193             }
194             }
195 118         331 $fh->print($stream);
196             ## $fh->print("\n"); # newline goes into endstream
197              
198             } elsif (defined $self->{' streamfile'}) {
199 1 50       49 open(my $dictfh, "<", $self->{' streamfile'}) || die "Unable to open $self->{' streamfile'}";
200 1         8 binmode($dictfh, ':raw');
201              
202 1         6 $fh->print("\nstream\n");
203 1         10 $loc = $fh->tell();
204 1         6 my $stream;
205 1         38 while (read($dictfh, $stream, 4096)) {
206 1 50       20 unless ($self->{' nofilt'}) {
207 0         0 foreach my $filter (reverse @filters) {
208 0         0 $stream = $filter->outfilt($stream, 0);
209             }
210             }
211 1         11 $fh->print($stream);
212             }
213 1         22 close $dictfh;
214 1 50       9 unless ($self->{' nofilt'}) {
215 0         0 $stream = '';
216 0         0 foreach my $filter (reverse @filters) {
217 0         0 $stream = $filter->outfilt($stream, 1);
218             }
219 0         0 $fh->print($stream);
220             }
221             ## $fh->print("\n"); # newline goes into endstream
222             }
223              
224 1169 100 100     4167 if (defined $self->{' stream'} or defined $self->{' streamfile'}) {
225 119         301 my $length = $fh->tell() - $loc;
226 119 100       753 unless ($self->{'Length'}{'val'} == $length) {
227 10         30 $self->{'Length'}{'val'} = $length;
228 10 50       61 $pdf->out_obj($self->{'Length'}) if $self->{'Length'}->is_obj($pdf);
229             }
230              
231 119         380 $fh->print("\nendstream"); # next is endobj which has the final cr
232             }
233 1169         3551 return;
234             }
235              
236             =head2 $d->read_stream($force_memory)
237              
238             Reads in a stream from a PDF file. If the stream is greater than
239             C (defaults to 32768) bytes to be stored, then
240             the default action is to create a file for it somewhere and to use that
241             file as a data cache. If $force_memory is set, this caching will not
242             occur and the data will all be stored in the $self->{' stream'}
243             variable.
244              
245             =cut
246              
247             sub read_stream {
248 7     7 1 19 my ($self, $force_memory) = @_;
249              
250 7         15 my $fh = $self->{' streamsrc'};
251 7         24 my $len = $self->{'Length'}->val();
252              
253 7         16 $self->{' stream'} = '';
254              
255 7         13 my @filters;
256 7 100       17 if (defined $self->{'Filter'}) {
257 3         8 my $i = 0;
258 3         33 foreach my $filter ($self->{'Filter'}->elements()) {
259 3         10 my $filter_class = "PDF::Builder::Basic::PDF::Filter::" . $filter->val();
260 3 0       18 unless ($self->{'DecodeParms'}) {
    0          
    50          
261 3         53 push(@filters, $filter_class->new());
262 0 0       0 } elsif ($self->{'Filter'}->isa('PDF::Builder::Basic::PDF::Name') and $self->{'DecodeParms'}->isa('PDF::Builder::Basic::PDF::Dict')) {
263 0         0 push(@filters, $filter_class->new($self->{'DecodeParms'}));
264 0         0 } elsif ($self->{'DecodeParms'}->isa('PDF::Builder::Basic::PDF::Array')) {
265 0         0 my $parms = $self->{'DecodeParms'}->val()->[$i];
266 0         0 push(@filters, $filter_class->new($parms));
267             } else {
268 0         0 push(@filters, $filter_class->new());
269             }
270 3         7 $i++;
271             }
272             }
273              
274 7         13 my $last = 0;
275 7 50       20 if (defined $self->{' streamfile'}) {
276 0         0 unlink ($self->{' streamfile'});
277 0         0 $self->{' streamfile'} = undef;
278             }
279 7         18 seek $fh, $self->{' streamloc'}, 0;
280              
281 7         11 my $dictfh;
282 7         17 my $readlen = 4096;
283 7         26 for (my $i = 0; $i < $len; $i += $readlen) {
284 7         11 my $data;
285 7 50       18 unless ($i + $readlen > $len) {
286 0         0 read($fh, $data, $readlen);
287             } else {
288 7         12 $last = 1;
289 7         27 read($fh, $data, $len - $i);
290             }
291              
292 7         16 foreach my $filter (@filters) {
293 3         13 $data = $filter->infilt($data, $last);
294             }
295              
296             # Start using a temporary file if the stream gets too big
297 7 50 66     52 if (not $force_memory and
      66        
298             not defined $self->{' streamfile'} and
299             (length($self->{' stream'}) + length($data)) > $mincache) {
300 0         0 $dictfh = File::Temp->new(TEMPLATE => 'pdfXXXXX', SUFFIX => 'dat', TMPDIR => 1);
301 0         0 $self->{' streamfile'} = $dictfh->filename();
302 0         0 print $dictfh $self->{' stream'};
303 0         0 undef $self->{' stream'};
304             }
305              
306 7 50       29 if (defined $self->{' streamfile'}) {
307 0         0 print $dictfh $data;
308             } else {
309 7         26 $self->{' stream'} .= $data;
310             }
311             }
312              
313 7 50       18 close $dictfh if defined $self->{' streamfile'};
314 7         11 $self->{' nofilt'} = 0;
315 7         34 return $self;
316             }
317              
318             =head2 $d->val()
319              
320             Returns the dictionary, which is itself.
321              
322             =cut
323              
324             sub val {
325 0     0 1   return $_[0];
326             }
327              
328             1;