File Coverage

blib/lib/CAM/PDFTaxforms.pm
Criterion Covered Total %
statement 196 260 75.3
branch 86 170 50.5
condition 13 39 33.3
subroutine 7 8 87.5
pod 5 5 100.0
total 307 482 63.6


line stmt bran cond sub pod time code
1             package CAM::PDFTaxforms;
2              
3 4     4   128006 use 5.006;
  4         34  
4             #use warnings;
5             #use strict;
6 4     4   1551 use parent 'CAM::PDF';
  4         1111  
  4         20  
7              
8             our $VERSION = '1.10';
9              
10             =head1 NAME
11              
12             CAM::PDFTaxforms - CAM::PDF wrapper to also allow editing of checkboxes (ie. for IRS Tax forms).
13              
14             =head1 AUTHOR
15              
16             Jim Turner C<< >>.
17              
18             This module is a wrapper around and a drop-in replacement for
19             L, by Chris Dolan.
20              
21             =head1 ACKNOWLEDGMENTS
22              
23             Thanks to Chris Dolan and everyone involved in developing and
24             supporting CAM::PDF, on which this module is based and relies on.
25              
26             =head1 LICENSE AND COPYRIGHT
27              
28             Copyright (c) 2010-2019 Jim Turner C<< >>
29              
30             This library is free software; you can redistribute it and/or modify it
31             under the same terms as CAM::PDF and Perl itself.
32              
33             L:
34              
35             Copyright (c) 2002-2006 Clotho Advanced Media, Inc., L
36              
37             Copyright (c) 2007-2008 Chris Dolan
38              
39             This library is free software; you can redistribute it and/or modify it
40             under the same terms as Perl itself.
41              
42             =head1 SYNOPSIS
43              
44             #!/usr/bin/perl -w
45              
46             use strict;
47             use CAM::PDFTaxforms;
48             my $pdf = CAM::PDFTaxforms->new('f1040.pdf') or die "Could not open PDF ($!)!";
49             my $page1 = $pdf->getPageContent(1);
50              
51             #DISPLAY THE LIST NAMES OF EDITABLE FIELDS:
52             my @fieldnames = $pdf->getFormFieldList();
53             print "--fields=".join('|',@fieldnames)."=\n";
54              
55             #UPDATE THE VALUES OF ONE OF THE FIELDS AND A COUPLE OF THE CHECKBOXES:
56             $pdf->fillFormFields('fieldname1' => 'value1', 'fieldname2' => 'value2');
57              
58             #WRITE THE UPDATED PDF FORM TO A NEW FILE NAME:
59             $pdf->cleanoutput('f1040_completed.pdf');
60              
61             Many example programs are included in this distribution to do useful
62             tasks. See the C subdirectory.
63              
64             =head1 DESCRIPTION
65              
66             This package is a wrapper for and creates a L object. The
67             difference is that some method functions are overridden to fix some
68             issues and add some new features, namely to better handle IRS tax
69             forms, many of which have checkboxes, in addition to numeric and text
70             fields. Several other patches have also been applied, particularly
71             those provided by CAM::PDF bugs #58144, #122890 and #125299.
72             Otherwise, it should work well as a full drop-in replacement for
73             CAM::PDF in the API.
74              
75             CAM::PDF description:
76              
77             This package reads and writes any document that conforms to the PDF
78             specification generously provided by Adobe at
79             L
80             (link last checked Oct 2005).
81              
82             The file format through PDF 1.5 is well-supported, with the exception
83             of the "linearized" or "optimized" output format, which this module
84             can read but not write. Many specific aspects of the document model
85             are not manipulable with this package (like fonts), but if the input
86             document is correctly written, then this module will preserve the
87             model integrity.
88              
89             The PDF writing feature saves as PDF 1.4-compatible. That means that
90             we cannot write compressed object streams. The consequence is that
91             reading and then writing a PDF 1.5+ document may enlarge the resulting
92             file by a fair margin.
93              
94             This library grants you some power over the PDF security model. Note
95             that applications editing PDF documents via this library MUST respect
96             the security preferences of the document. Any violation of this
97             respect is contrary to Adobe's intellectual property position, as
98             stated in the reference manual at the above URL.
99              
100             Technical detail regarding corrupt PDFs: This library adheres strictly
101             to the PDF specification. Adobe's Acrobat Reader is more lenient,
102             allowing some corrupted PDFs to be viewable. Therefore, it is
103             possible that some PDFs may be readable by Acrobat that are illegible
104             to this library. In particular, files which have had line endings
105             converted to or from DOS/Windows style (i.e. CR-NL) may be rendered
106             unusable even though Acrobat does not complain. Future library
107             versions may relax the parser, but not yet.
108              
109             This version is HACKED by Jim Turner 09/2010 to enable the fillFormFields()
110             function to also modify checkboxes (primarily on IRS Tax forms).
111              
112             =head1 EXAMPLES
113              
114             See the I subdirectory in the source tree. There is a sample
115             blank 2018 official IRS Schedule B tax form and two programs:
116             I, which fills in the form using the sample input data
117             text file I, and creates a filled in version of the
118             form called I. The other program (I)
119             can read the data filled in the filled in form created by the other
120             program and displays it as output.
121              
122             To run the programs, switch to the I subdirectory in the source
123             tree and run them without arguments (ie. B<./dof1040sb.pl>).
124              
125             To see the names of the fields and their current values in a PDF form,
126             such as the aforementioned tax form, run the included program, ie:
127             I.
128              
129             =head1 API
130              
131             =head2 Functions intended to be used externally
132              
133             $self = CAM::PDFTaxforms->new(content | filename | '-')
134             $self->toPDF()
135             $self->needsSave()
136             $self->save()
137             $self->cleansave()
138             $self->output(filename | '-')
139             $self->cleanoutput(filename | '-')
140             $self->previousRevision()
141             $self->allRevisions()
142             $self->preserveOrder()
143             $self->appendObject(olddoc, oldnum, [follow=(1|0)])
144             $self->replaceObject(newnum, olddoc, oldnum, [follow=(1|0)])
145             (olddoc can be undef in the above for adding new objects)
146             $self->numPages()
147             $self->getPageText(pagenum)
148             $self->getPageDimensions(pagenum)
149             $self->getPageContent(pagenum)
150             $self->setPageContent(pagenum, content)
151             $self->appendPageContent(pagenum, content)
152             $self->deletePage(pagenum)
153             $self->deletePages(pagenum, pagenum, ...)
154             $self->extractPages(pagenum, pagenum, ...)
155             $self->appendPDF(CAM::PDF object)
156             $self->prependPDF(CAM::PDF object)
157             $self->wrapString(string, width, fontsize, page, fontlabel)
158             $self->getFontNames(pagenum)
159             $self->addFont(page, fontname, fontlabel, [fontmetrics])
160             $self->deEmbedFont(page, fontname, [newfontname])
161             $self->deEmbedFontByBaseName(page, basename, [newfont])
162             $self->getPrefs()
163             $self->setPrefs()
164             $self->canPrint()
165             $self->canModify()
166             $self->canCopy()
167             $self->canAdd()
168             $self->getFormFieldList()
169             $self->fillFormFields(fieldname, value, [fieldname, value, ...])
170             or $self->fillFormFields(%values)
171             $self->clearFormFieldTriggers(fieldname, fieldname, ...)
172              
173             Note: 'clean' as in cleansave() and cleanobject() means write a fresh
174             PDF document. The alternative (e.g. save()) reuses the existing doc
175             and just appends to it. Also note that 'clean' functions sort the
176             objects numerically. If you prefer that the new PDF docs more closely
177             resemble the old ones, call preserveOrder() before cleansave() or
178             cleanobject().
179              
180             =head2 For additional methods and functions, see the L documentation.
181              
182             =head1 METHODS
183              
184             =over
185              
186             =item $doc = CAM::PDFTaxforms->new($content)
187              
188             =item $doc = CAM::PDFTaxforms->new($ownerpass, $userpass)
189              
190             =item $doc = CAM::PDFTaxforms->new($content, $ownerpass, $userpass, $prompt)
191              
192             =item $doc = CAM::PDFTaxforms->new($content, $ownerpass, $userpass, $options)
193              
194             Instantiate a new CAM::PDFTaxforms object. C<$content> can be a document
195             in a string, a filename, or '-'. The latter indicates that the document
196             should be read from standard input. If the document is password
197             protected, the passwords should be passed as additional arguments. If
198             they are not known, a boolean C<$prompt> argument allows the programmer to
199             suggest that the constructor prompt the user for a password. This is
200             rudimentary prompting: passwords are in the clear on the console.
201              
202             This constructor takes an optional final argument which is a hash
203             reference. This hash can contain any of the following optional
204             parameters:
205              
206             =over
207              
208             =item prompt_for_password => $boolean
209              
210             This is the same as the C<$prompt> argument described above.
211              
212             =item fault_tolerant => $boolean
213              
214             This flag causes the instance to be more lenient when reading the
215             input PDF. Currently, this only affects PDFs which cannot be
216             successfully decrypted.
217              
218             =back
219              
220             =item $hashref = $doc->getFieldValue('fieldname1' [, fieldname2, ... fieldnameN ])
221              
222             (CAM::PDFTaxforms only, not available in CAM::PDF)
223              
224             Fetches the corresponding current values for each field name in the
225             argument list. Returns a reference to a hash containing the field
226             names as keys and the corresponding values. If a field does not
227             exist or does not contain a value, an empty string is returned in
228             the hash as it's value. If called in array / hash context, then
229             a list of field names and values in the order (fieldname1, value1,
230             fieldname2, value2, ... fieldnameN valueN) is returned.
231              
232             =cut
233              
234             sub getFieldValue #JWT:NEW FUNCTION ADDED 20100921 TO RETURN CORRECT VALUES
235             #FOR EACH FIELD WHETHER IT'S A TEXT FIELD OR A CHECKBOX:
236             {
237 1     1 1 21 my $self = shift;
238 1         4 my @fieldNames = @_;
239              
240 1         3 my ($objnode, $propdict, $dict, $fieldType, $fieldHashRef);
241 1         3 LOOP1: foreach my $fieldName (@fieldNames)
242             {
243 3         10 $objnode = $self->getFormField($fieldName);
244 3         8 $fieldHashRef->{$fieldName} = undef;
245 3 50       8 next LOOP1 unless ($objnode);
246              
247             # This read-only dict includes inherited properties
248 3         11 my $propdict = $self->getFormFieldDict($objnode);
249              
250             # This read-write dict does not include inherited properties
251 3         2129 my $dict = $self->getValue($objnode);
252              
253 3 100 66     53 if ($propdict->{FT} && $self->getValue($propdict->{FT}) =~ /^Btn$/o) {
254             $fieldHashRef->{$fieldName} = (defined $dict->{AS}->{value})
255 1 50       21 ? $dict->{AS}->{value} : $dict->{V}->{value};
256             } else {
257 2         33 $fieldHashRef->{$fieldName} = $dict->{V}->{value};
258             }
259             }
260 1 50       6 return $fieldHashRef unless (wantarray); #RETURN HASHREF IN SCALAR CONTEXT.
261 1         3 my @fieldValues;
262 1         3 foreach my $fieldName (@fieldNames) #BUILD ARRAY FROM HASH TO RETURN IN ARRAY CONTEXT:
263             {
264 3         11 push (@fieldValues, $fieldName, $fieldHashRef->{$fieldName});
265             }
266 1         8 return @fieldValues;
267             }
268              
269             =item $doc->fillFormFields($name => $value, ...)
270              
271             =item $doc->fillFormFields($opts_hash, $name => $value, ...)
272              
273             Set the default values of PDF form fields. The name should be the
274             full hierarchical name of the field as output by the
275             getFormFieldList() function. The argument list can be a hash if you
276             like. A simple way to use this function is something like this:
277              
278             my %fields = (fname => 'John', lname => 'Smith', state => 'WI');
279             $field{zip} = 53703;
280             $self->fillFormFields(%fields);
281              
282             NOTE: For checkbox fields specify any value that is I in Perl
283             (ie. 0, '', or I), or any of the strings: 'Off', 'No', or
284             'Unchecked' (case insensitive) to un-check a checkbox, or any other
285             value that is I in Perl to check it. Checkbox fields are only
286             supported by CAM::PDFTaxforms and was the original reason for
287             creating it.
288              
289             If the first argument is a hash reference, it is interpreted as
290             options for how to render the filled data:
291              
292             =over
293              
294             =item background_color =E 'none' | $gray | [$r, $g, $b]
295              
296             Specify the background color for the text field.
297              
298             =back
299              
300             =cut
301              
302             sub fillFormFields ## no critic(Subroutines::ProhibitExcessComplexity, Unpack)
303             {
304 12     12 1 1685 my $self = shift;
305 12 50       36 my $opts = ref $_[0] ? shift : {};
306 12         41 my @list = (@_);
307              
308             my %opts = (
309             background_color => 1,
310 12         17 %{$opts},
  12         51  
311             );
312              
313 12         23 my $filled = 0;
314 12         35 LOOP1: while (@list > 0)
315             {
316 25         53 my $key = shift @list;
317 25         41 my $value = shift @list;
318              
319 25 50       63 $value = q{} unless (defined $value);
320 25 50 33     116 next if (!$key || ref($key));
321              
322 25         59 my $objnode = $self->getFormField($key);
323 25 50       66 next if (!$objnode);
324              
325 25         51 my $objnum = $objnode->{objnum};
326 25         46 my $gennum = $objnode->{gennum};
327              
328             # This read-only dict includes inherited properties
329 25         75 my $propdict = $self->getFormFieldDict($objnode);
330              
331             # This read-write dict does not include inherited properties
332 25         22361 my $dict = $self->getValue($objnode);
333 25         387 $dict->{V} = CAM::PDF::Node->new('string', $value, $objnum, $gennum);
334              
335 25 50 33     422 if ($propdict->{FT} && $self->getValue($propdict->{FT}) =~ /^(Tx|Btn)$/o) # Is it a text field?
336             {
337 25         344 my $fieldType = $1; #JWT:ADDED NEXT 6 TO ALLOW SETTING OF CHECKBOX BUTTONS (VALUE MUST BE EITHER "Yes" or "Off"!:
338 25 100       60 if ($fieldType eq 'Btn')
339             {
340 2 50       11 if ($dict->{AS}->{value} =~ /^(?:Yes|Off)$/o) {
341 2         6 $dict->{AS}->{value} = $dict->{V}->{value};
342             } else {
343 0         0 my @kidnames = $self->getFormFieldList($key);
344 0 0       0 if (@kidnames > 0) {
345             local * setRadioButtonKids = sub {
346 0     0   0 my ($indx, $vindx) = @_;
347 0         0 my $objnode = $self->getFormField($kidnames[$indx]);
348 0 0       0 return unless ($objnode);
349 0         0 my $dict = $self->getValue($objnode);
350 0 0       0 if ($indx == $vindx) {
351 0 0 0     0 $dict->{AS}->{value} = (!$value || $value =~ /^(?:Off|No|Unchecked)$/io) ? 'Off' : 'Yes'; #JWT:HAVE TO HAVE TO GET THE RADIO BUTTON CHECKED!
352             } else {
353 0         0 $dict->{AS}->{value} = 'Off';
354             }
355 0         0 return;
356 0         0 };
357              
358 0         0 my $vindx = $value - 1;
359 0         0 for (my $i=0;$i<=$#kidnames;$i++) {
360 0         0 &setRadioButtonKids($i, $vindx);
361             }
362             }
363             }
364 2         4 $filled++;
365 2         13 next LOOP1;
366             }
367             else
368             {
369 23         44 $dict->{V}->{value} = $value;
370             }
371              
372             # Set up display of form value
373 23 50       74 $dict->{AP} = CAM::PDF::Node->new('dictionary', {}, $objnum, $gennum) if (!$dict->{AP});
374 23 50       324 if (!$dict->{AP}->{value}->{N})
375             {
376 23         55 my $newobj = CAM::PDF::Node->new('object',
377             CAM::PDF::Node->new('dictionary',{}),
378             );
379 23         452 my $num = $self->appendObject(undef, $newobj, 0);
380 23         2410 $dict->{AP}->{value}->{N} = CAM::PDF::Node->new('reference', $num, $objnum, $gennum);
381             }
382 23         360 my $formobj = $self->dereference($dict->{AP}->{value}->{N}->{value}); #xxxJWT:CHGD. TO NEXT:
383 23         255 my $formonum = $formobj->{objnum};
384 23         39 my $formgnum = $formobj->{gennum};
385 23         45 my $formdict = $self->getValue($formobj);
386              
387 23 50       409 $formdict->{Subtype} = CAM::PDF::Node->new('label', 'Form', $formonum, $formgnum) if (!$formdict->{Subtype});
388 23         327 my @rect = (0,0,0,0);
389 23 50       70 if ($dict->{Rect})
390             {
391             ## no critic(Bangs::ProhibitNumberedNames)
392 23         54 my $r = $self->getValue($dict->{Rect});
393 23         199 my ($x1, $y1, $x2, $y2) = @{$r};
  23         61  
394 23         47 @rect = (
395             $self->getValue($x1),
396             $self->getValue($y1),
397             $self->getValue($x2),
398             $self->getValue($y2),
399             );
400             }
401 23         711 my $dx = $rect[2]-$rect[0];
402 23         56 my $dy = $rect[3]-$rect[1];
403 23 50       48 if (!$formdict->{BBox})
404             {
405 23         57 $formdict->{BBox} = CAM::PDF::Node->new('array',
406             [
407             CAM::PDF::Node->new('number', 0, $formonum, $formgnum),
408             CAM::PDF::Node->new('number', 0, $formonum, $formgnum),
409             CAM::PDF::Node->new('number', $dx, $formonum, $formgnum),
410             CAM::PDF::Node->new('number', $dy, $formonum, $formgnum),
411             ],
412             $formonum, $formgnum);
413             }
414 23         1378 my $text = $value;
415 23         47 $text =~ s/ \r\n? /\n/gxmso;
416 23         36 $text =~ s/ \n+\z //xmso;
417              
418 23         29 my @rsrcs;
419 23         35 my $fontmetrics = 0;
420 23         34 my $fontname = q{};
421 23         29 my $fontsize = 0;
422 23         32 my $da = q{};
423 23         31 my $tl = q{};
424             #JWT:CHGD TO NEXT PER BUG#122890: my $border = 2;
425 23         36 my $border = 1;
426 23         72 my $tx = $border;
427             #JWT:CHGD TO NEXT PER BUG#122890: my $ty = $border + 2;
428 23         32 my $ty = $border + 1;
429 23         33 my $stringwidth;
430 23 50       54 if ($propdict->{DA}) {
431 23         54 $da = $self->getValue($propdict->{DA});
432              
433             # Try to pull out all of the resources used in the text object
434 23         302 @rsrcs = ($da =~ m{ /([^\s<>/\[\]()]+) }gxmso);
435              
436             # Try to pull out the font size, if any. If more than
437             # one, pick the last one. Font commands look like:
438             # "/ Tf"
439             #JWT: CHGD. TO NEXT (BUG#58144 PATCH): if ($da =~ m{ \s*/(\w+)\s+(\d+)\s+Tf.*? \z }xms)
440 23 50       146 if ($da =~ m{ \s*/([\w-]+)\s+([.\d]+)\s+Tf.*? \z }xmso)
441             {
442 23         61 $fontname = $1;
443 23         45 $fontsize = $2;
444 23 50       43 if ($fontname)
445             {
446 23 50       60 if ($propdict->{DR})
447             {
448 0         0 my $dr = $self->getValue($propdict->{DR});
449 0         0 $fontmetrics = $self->getFontMetrics($dr, $fontname);
450             }
451             #print STDERR "Didn't get font\n" if (!$fontmetrics);
452             }
453             }
454             }
455              
456 23         57 my %flags = (
457             Justify => 'left',
458             );
459 23 100       50 if ($propdict->{Ff})
460             {
461             # Just decode the ones we actually care about
462             # PDF ref, 3rd ed pp 532,543
463 22         56 my $ff = $self->getValue($propdict->{Ff});
464 22         372 my @flags = split m//xms, unpack 'b*', pack 'V', $ff;
465 22         70 $flags{ReadOnly} = $flags[0];
466 22         47 $flags{Required} = $flags[1];
467 22         40 $flags{NoExport} = $flags[2];
468 22         37 $flags{Multiline} = $flags[12];
469 22         36 $flags{Password} = $flags[13];
470 22         44 $flags{FileSelect} = $flags[20];
471 22         33 $flags{DoNotSpellCheck} = $flags[22];
472 22         76 $flags{DoNotScroll} = $flags[23];
473             }
474 23 50       48 if ($propdict->{Q})
475             {
476 23   100     55 my $q = $self->getValue($propdict->{Q}) || 0;
477 23 100       247 $flags{Justify} = $q==2 ? 'right' : ($q==1 ? 'center' : 'left');
    100          
478             }
479              
480             # The order of the following sections is important!
481 23 50       48 $text =~ s/ [^\n] /*/gxms if ($flags{Password}); # Asterisks for password characters
482              
483 23 50 33     52 if ($fontmetrics && ! $fontsize)
484             {
485             # Fix autoscale fonts
486 0         0 $stringwidth = 0;
487 0         0 my $lines = 0;
488 0         0 for my $line (split /\n/xmso, $text) # trailing null strings omitted
489             {
490 0         0 $lines++;
491 0         0 my $w = $self->getStringWidth($fontmetrics, $line);
492 0 0 0     0 $stringwidth = $w if ($w && $w > $stringwidth);
493             }
494 0   0     0 $lines ||= 1;
495             # Initial guess
496 0         0 $fontsize = ($dy - 2 * $border) / ($lines * 1.5);
497 0         0 my $fontwidth = $fontsize * $stringwidth;
498 0         0 my $maxwidth = $dx - 2 * $border;
499 0 0       0 $fontsize *= $maxwidth / $fontwidth if ($fontwidth > $maxwidth);
500 0         0 $da =~ s/ \/$fontname\s+0\s+Tf\b /\/$fontname $fontsize Tf/gxms;
501             }
502 23 50       50 if ($fontsize)
503             {
504             # This formula is TOTALLY empirical. It's probably wrong.
505             # #JWT:CHGD. TO NEXT: $ty = $border + 2 + (9 - $fontsize) * 0.4;
506 23         74 $ty = $border + 2 + (5 - $fontsize) * 0.4;
507             }
508              
509              
510             # escape characters
511 23         65 $text = $self->writeString($text);
512              
513 23 50       650 if ($flags{Multiline})
514             {
515             # TODO: wrap the field with wrapString()??
516             # Shawn Dawson of Silent Solutions pointed out that this does not auto-wrap the input text
517              
518 0         0 my $linebreaks = $text =~ s/ \\n /\) Tj T* \(/gxms;
519              
520             # Total guess work:
521             # line height is either 150% of fontsize or thrice
522             # the corner offset
523 0 0       0 $tl = $fontsize ? $fontsize * 1.5 : $ty * 3;
524              
525             # Bottom aligned
526             #$ty += $linebreaks * $tl;
527             # Top aligned
528 0         0 $ty = $dy - $border - $tl;
529 0 0       0 warn 'Justified text not supported for multiline fields' if ($flags{Justify} ne 'left');
530 0         0 $tl .= ' TL';
531             }
532             else
533             {
534             #JWT: CHGD. TO NEXT (BUG#58144 PATCH): if ($flags{Justify} ne 'left' && $fontmetrics)
535 23 100       55 if ($flags{Justify} ne 'left')
536             {
537             #JWT: CHGD. TO NEXT 8: my $width = $stringwidth || $self->getStringWidth($fontmetrics, $text);
538 13         21 my $width;
539 13 50 33     51 if ($stringwidth || $fontmetrics) {
540             #JWT:CHGD TO NEXT PER BUG#122890: $width = $self->getStringWidth($fontmetrics, $text);
541 0         0 $width = $self->getStringWidth($fontmetrics, (substr $text, 1, (length $text)-2));
542             } else { #JWT: NO FONT METRICS, SO HAVE TO GUESS WIDTH:
543 13         29 $width = (length($text)-1) * 0.57; #JWT:FIXME (HACK) FOR RIGHT-JUSTIFYING STANDARD SIZE 8 NUMERIC FONT.
544 13         21 my $commas = $text;
545 13         44 $width -= 0.29 while ($commas =~ s/\,//o); #JWT:FIXME (HACK) FUDGE FOR WIDTH OF COMMAS (SMALLER THAN DIGITS)
546             }
547 13         22 my $diff = $dx - $width * $fontsize;
548 13 50       31 $diff = 0 if ($diff < 0);
549              
550 13 100       78 if ($flags{Justify} eq 'center')
    50          
551             {
552 1         11 $text = ($diff/2)." 0 Td $text";
553             }
554             elsif ($flags{Justify} eq 'right')
555             {
556 12         75 $text = "$diff 0 Td $text";
557             }
558             }
559             }
560              
561             # Move text from lower left corner of form field
562 23         142 my $tm = "1 0 0 1 $tx $ty Tm ";
563              
564             # if not 'none', draw a background as a filled rectangle of solid color
565             my $background_color
566             = $opts{background_color} eq 'none' ? q{}
567 23 50       83 : ref $opts{background_color} ? "@{$opts{background_color}} rgb"
  0 50       0  
568             : "$opts{background_color} g";
569 23 50       132 my $background = $background_color ? "$background_color 0 0 $dx $dy re f" : q{};
570              
571 23         62 $text = "$tl $da $tm $text Tj";
572 23         168 $text = "$background /Tx BMC q 1 1 ".($dx-$border).q{ }.($dy-$border)." re W n BT $text ET Q EMC";
573             # my $len = ($fieldType eq 'Btn') ? 0 : length($text); #JWT:CHANGED
574 23 50       61 unless ($fieldType eq 'Btn') #JWT:ADDED CONDITION:
575             {
576 23         72 $formdict->{Length} = CAM::PDF::Node->new('number', $len, $formonum, $formgnum);
577             # JWT:NEXT 3 ADDED PER BUG#125299 PATCH:
578 23         375 $formdict->{StreamData} = CAM::PDF::Node->new('stream', $text, $formonum, $formgnum);
579 23         303 delete $formdict->{ Filter };
580 23         70 $self-> encodeObject( $formonum, 'FlateDecode' );
581             }
582              
583 23 50       12052 if (@rsrcs > 0) {
584 23 50       85 $formdict->{Resources} = CAM::PDF::Node->new('dictionary', {}, $formonum, $formgnum) if (!$formdict->{Resources});
585 23         327 my $rdict = $self->getValue($formdict->{Resources});
586 23 50       210 if (!$rdict->{ProcSet})
587             {
588 23         54 $rdict->{ProcSet} = CAM::PDF::Node->new('array',
589             [
590             CAM::PDF::Node->new('label', 'PDF', $formonum, $formgnum),
591             CAM::PDF::Node->new('label', 'Text', $formonum, $formgnum),
592             ],
593             $formonum,$formgnum);
594             }
595 23 50       870 $rdict->{Font} = CAM::PDF::Node->new('dictionary', {}, $formonum, $formgnum) if (!$rdict->{Font});
596              
597 23         323 my $fdict = $self->getValue($rdict->{Font});
598              
599             # Search out font resources. This is a total kluge.
600             # TODO: the right way to do this is to look for the DR
601             # attribute in the form element or it's ancestors.
602 23         198 for my $font (@rsrcs)
603             {
604             #JWT: CHGD. TO NEXT 11 (BUG#58144 PATCH): my $fobj = $self->dereference("/$font", 'All');
605             #JWT: CHGD. TO NEXT 11 (BUG#58144 PATCH): if (!$fobj)
606 23         60 my $root = $self->getRootDict()->{AcroForm};
607 23         716 my $ifdict = $self->getValue($root);
608 23 50       571 if (!exists $ifdict->{DR})
609             {
610             #JWT:die "Could not find resource /$font while preparing form field $key\n";
611 0         0 warn "Could not find resource1 /$font while preparing form field $key\n";
612             }
613 23         44 my $dr = $self->getValue($ifdict->{DR});
614 23         190 my $fobjnum = $dr->{Font}->{value}->{$font}->{value};
615              
616 23 50       46 if (!$fobjnum)
617             {
618             #JWT:die "Could not find resource /$font while preparing form field $key\n";
619 0         0 warn "Could not find resource2 /$font while preparing form field $key\n";
620             }
621             #JWT: CHGD. TO NEXT (BUG#58144 PATCH): $fdict->{$font} = CAM::PDF::Node->new('reference', $fobj->{objnum}, $formonum, $formgnum);
622 23         49 $fdict->{$font} = CAM::PDF::Node->new('reference', $fobjnum, $formonum, $formgnum);
623             }
624             }
625             }
626 23         542 $filled++;
627             }
628              
629 12         72 return $filled;
630             }
631              
632             =item $doc->getFormFieldList()
633              
634             Return an array of the names of all of the PDF form fields. The names
635             are the full hierarchical names constructed as explained in the PDF
636             reference manual. These names are useful for the fillFormFields()
637             function.
638              
639             =cut
640              
641             sub getFormFieldList
642             {
643 220     220 1 173069 my $self = shift;
644 220         305 my $parentname = shift; # very optional
645              
646 220 100       540 my $prefix = (defined $parentname ? $parentname . q{.} : q{});
647              
648 220         304 my $kidlist;
649 220 100 66     820 if (defined $parentname && $parentname ne q{})
650             {
651 218         484 my $parent = $self->getFormField($parentname);
652 218 50       439 return if (!$parent);
653 218         406 my $dict = $self->getValue($parent);
654 218 100       3215 return if (!exists $dict->{Kids});
655 4         9 $kidlist = $self->getValue($dict->{Kids});
656             }
657             else
658             {
659 2         8 my $root = $self->getRootDict()->{AcroForm};
660 2 50       105 return if (!$root);
661 2         8 my $parent = $self->getValue($root);
662 2 50       3526 return if (!exists $parent->{Fields});
663 2         9 $kidlist = $self->getValue($parent->{Fields});
664             }
665              
666 6         49 my @list;
667 6         10 my $nonamecnt = '0';
668 6         10 for my $kid (@{$kidlist})
  6         14  
669             {
670 218 50 33     1321 if ((! ref $kid) || (ref $kid) ne 'CAM::PDF::Node' || $kid->{type} ne 'reference')
      33        
671             {
672 0         0 die "Expected a reference as the form child of '$parentname'\n";
673             }
674 218         539 my $objnode = $self->dereference($kid->{value});
675 218         287880 my $dict = $self->getValue($objnode);
676 218         2963 my $name = "(no name$nonamecnt)"; # assume the worst
677 218         372 ++$nonamecnt;
678 218 50       701 $name = $self->getValue($dict->{T}) if (exists $dict->{T});
679 218         1929 $name = $prefix . $name;
680 218         953 $name =~ s/\x00//gso; #JWT:HANDLE IRS'S FSCKED-UP HIGH-ASCII FIELD NAMES!
681 218         479 push @list, $name;
682 218 50       456 push @list, $prefix . $self->getValue($dict->{TU}) . ' (alternate name)' if (exists $dict->{TU});
683 218         691 $self->{formcache}->{$name} = $objnode;
684 218         507 my @kidnames = $self->getFormFieldList($name);
685 218 100       623 if (@kidnames > 0)
686             {
687             #push @list, 'descend...';
688 4         69 push @list, @kidnames;
689             #push @list, 'ascend...';
690             }
691             }
692 6         247 return @list;
693             }
694              
695             =item $doc->getFormField($name)
696              
697             I
698              
699             Return the object containing the form field definition for the
700             specified field name. C<$name> can be either the full name or the
701             "short/alternate" name.
702              
703             =cut
704              
705             sub getFormField
706             {
707 246     246 1 397 my $self = shift;
708 246         338 my $fieldname = shift;
709              
710 246 50       517 return if (!defined $fieldname);
711              
712 246 50       540 if (! exists $self->{formcache}->{$fieldname})
713             {
714 0         0 my $kidlist;
715             my $parent;
716 0 0       0 if ($fieldname =~ m/ [.] /xms)
717             {
718 0         0 my $parentname;
719             #JWT: CHGD. TO NEXT (BUG#58144 PATCH): if ($fieldname =~ s/ \A(.*)[.]([.]+)\z /$2/xms)
720 0 0       0 $parentname = $1 if ($fieldname =~ s/ \A(.*)[.]([^.]+)\z /$2/xms);
721 0 0       0 return unless ($parentname);
722 0         0 $parent = $self->getFormField($parentname);
723 0 0       0 return unless ($parent);
724 0         0 my $dict = $self->getValue($parent);
725 0 0       0 return unless (exists $dict->{Kids});
726 0         0 $kidlist = $self->getValue($dict->{Kids});
727             }
728             else
729             {
730 0         0 my $root = $self->getRootDict()->{AcroForm};
731 0 0       0 return unless ($root);
732 0         0 $parent = $self->dereference($root->{value});
733 0 0       0 return unless ($parent);
734 0         0 my $dict = $self->getValue($parent);
735 0 0       0 return unless (exists $dict->{Fields});
736 0         0 $kidlist = $self->getValue($dict->{Fields});
737             }
738              
739 0         0 $self->{formcache}->{$fieldname} = undef; # assume the worst...
740 0         0 for my $kid (@{$kidlist})
  0         0  
741             {
742 0         0 my $objnode = $self->dereference($kid->{value});
743 0         0 $objnode->{formparent} = $parent;
744 0         0 my $dict = $self->getValue($objnode);
745 0 0       0 $self->{formcache}->{$self->getValue($dict->{T})} = $objnode if (exists $dict->{T});
746 0 0       0 $self->{formcache}->{$self->getValue($dict->{TU})} = $objnode if (exists $dict->{TU});
747             }
748             }
749              
750 246         435 return $self->{formcache}->{$fieldname};
751             }
752              
753             =item $doc->writeAny($node)
754              
755             Returns the serialization of the specified node. This handles all
756             Node types, including object Nodes.
757              
758             =cut
759              
760             sub writeAny
761             {
762 22413     22413 1 5023308 my $self = shift;
763 22413         26346 my $objnode = shift;
764              
765 22413 50       37182 if (! ref $objnode)
766             {
767 0         0 die 'Not a ref';
768             }
769              
770 22413         34894 my $key = $objnode->{type};
771              
772 22413 50 33     54840 return 1 unless (defined($key) && $key); #JWT:ADDED!
773              
774 22413         31084 my $val = $objnode->{value};
775 22413         30695 my $objnum = $objnode->{objnum};
776 22413         27762 my $gennum = $objnode->{gennum};
777              
778             return $key eq 'string' ? $self->writeString($self->{crypt}->encrypt($self, $val, $objnum, $gennum))
779 22413 50 0     73682 : $key eq 'hexstring' ? '<' . (unpack 'H*', $self->{crypt}->encrypt($self, $val, $objnum, $gennum)) . '>'
    100          
    100          
    100          
    50          
    100          
    100          
    100          
    100          
    100          
780             : $key eq 'number' ? "$val"
781             : $key eq 'reference' ? "$val 0 R" # TODO: lookup the gennum and use it instead of 0 (?)
782             : $key eq 'boolean' ? $val
783             : $key eq 'null' ? 'null'
784             : $key eq 'label' ? "/$val"
785             : $key eq 'array' ? $self->_writeArray($objnode)
786             : $key eq 'dictionary' ? $self->_writeDictionary($objnode)
787             : $key eq 'object' ? $self->_writeObject($objnode)
788             #JWT:CHGD. TO NEXT (TO PREVENT DEATH!): : die "Unknown key '$key' in writeAny (objnum ".($objnum||'').")\n";
789             : warn "Unknown key '$key' (value=$val= objnum=$objnum gen=$gennum) in writeAny (objnum ".($objnum||'').")\n";
790             }
791              
792             1;
793              
794             __END__