File Coverage

blib/lib/CAM/PDFTaxforms.pm
Criterion Covered Total %
statement 187 240 77.9
branch 70 144 48.6
condition 13 34 38.2
subroutine 8 8 100.0
pod 4 4 100.0
total 282 430 65.5


line stmt bran cond sub pod time code
1             package CAM::PDFTaxforms;
2              
3 5     5   194472 use 5.006;
  5         36  
4 5     5   23 use warnings;
  5         7  
  5         120  
5 5     5   23 use strict;
  5         8  
  5         115  
6 5     5   1952 use parent 'CAM::PDF';
  5         1363  
  5         26  
7              
8             our $VERSION = '1.00';
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 EXAMPLE
113              
114             See the example 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 examples 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::PDFTaxform->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 19 my $self = shift;
238 1         4 my @fieldNames = @_;
239              
240 1         2 my ($objnode, $propdict, $dict, $fieldType, $fieldHashRef);
241 1         10 LOOP1: foreach my $fieldName (@fieldNames)
242             {
243 3         12 $objnode = $self->getFormField($fieldName);
244 3         8 $fieldHashRef->{$fieldName} = undef;
245 3 50       10 next LOOP1 unless ($objnode);
246              
247             # This read-only dict includes inherited properties
248 3         19 my $propdict = $self->getFormFieldDict($objnode);
249              
250             # This read-write dict does not include inherited properties
251 3         9212 my $dict = $self->getValue($objnode);
252              
253 3 100 66     55 if ($propdict->{FT} && $self->getValue($propdict->{FT}) =~ /^Btn$/o) {
254 1 50       21 $fieldHashRef->{$fieldName} = ($dict->{AS}->{value} =~ /^Yes$/io) ? 1 : 0;
255             } else {
256 2         35 $fieldHashRef->{$fieldName} = $dict->{V}->{value};
257             }
258             }
259 1 50       8 return $fieldHashRef unless (wantarray); #RETURN HASHREF IN SCALAR CONTEXT.
260 0         0 my @fieldValues;
261 0         0 foreach my $fieldName (@fieldNames) #BUILD ARRAY FROM HASH TO RETURN IN ARRAY CONTEXT:
262             {
263 0         0 push (@fieldValues, $fieldName, $fieldHashRef->{$fieldName});
264             }
265 0         0 return @fieldValues;
266             }
267              
268             =item $doc->fillFormFields($name => $value, ...)
269              
270             =item $doc->fillFormFields($opts_hash, $name => $value, ...)
271              
272             Set the default values of PDF form fields. The name should be the
273             full hierarchical name of the field as output by the
274             getFormFieldList() function. The argument list can be a hash if you
275             like. A simple way to use this function is something like this:
276              
277             my %fields = (fname => 'John', lname => 'Smith', state => 'WI');
278             $field{zip} = 53703;
279             $self->fillFormFields(%fields);
280              
281             NOTE: For checkbox fields specify any value that is I in Perl
282             (ie. 0, '', or I), or any of the strings: 'Off', 'No', or
283             'Unchecked' (case insensitive) to un-check a checkbox, or any other
284             value that is I in Perl to check it. Checkbox fields are only
285             supported by CAM::PDFTaxforms and was the original reason for
286             creating it.
287              
288             If the first argument is a hash reference, it is interpreted as
289             options for how to render the filled data:
290              
291             =over
292              
293             =item background_color =E 'none' | $gray | [$r, $g, $b]
294              
295             Specify the background color for the text field.
296              
297             =back
298              
299             =cut
300              
301             sub fillFormFields ## no critic(Subroutines::ProhibitExcessComplexity, Unpack)
302             {
303 12     12 1 1624 my $self = shift;
304 12 50       37 my $opts = ref $_[0] ? shift : {};
305 12         42 my @list = (@_);
306              
307             my %opts = (
308             background_color => 1,
309 12         20 %{$opts},
  12         41  
310             );
311              
312 12         18 my $filled = 0;
313 12         40 LOOP1: while (@list > 0)
314             {
315 25         47 my $key = shift @list;
316 25         45 my $value = shift @list;
317              
318 25 50       64 $value = q{} unless (defined $value);
319 25 50 33     111 next if (!$key || ref($key));
320              
321 25         58 my $objnode = $self->getFormField($key);
322 25 50       60 next if (!$objnode);
323              
324 25         51 my $objnum = $objnode->{objnum};
325 25         43 my $gennum = $objnode->{gennum};
326              
327             # This read-only dict includes inherited properties
328 25         77 my $propdict = $self->getFormFieldDict($objnode);
329              
330             # This read-write dict does not include inherited properties
331 25         23435 my $dict = $self->getValue($objnode);
332             $dict->{V} = CAM::PDF::Node->new('string', $value, $objnum, $gennum)
333 25 100       441 unless ($dict->{V}); #JWT:ADDED CONDITION!
334             #$dict->{DV} = CAM::PDF::Node->new('string', $value, $objnum, $gennum);
335              
336             #if ($propdict->{FT} && $self->getValue($propdict->{FT}) eq 'Tx') # Is it a text field? #JWT:CHGD. TO NEXT:
337 25 50 33     483 if ($propdict->{FT} && $self->getValue($propdict->{FT}) =~ /^(Tx|Btn)$/o) # Is it a text field?
338             {
339 25         357 my $fieldType = $1; #JWT:ADDED NEXT 6 TO ALLOW SETTING OF CHECKBOX BUTTONS (VALUE MUST BE EITHER "Yes" or "Off"!:
340 25 100       56 if ($fieldType eq 'Btn')
341             {
342 2 50 33     16 $dict->{AS}->{value} = (!$value || $value =~ /^(?:Off|No|Unchecked)$/io) ? 'Off' : 'Yes';
343 2         5 $filled++;
344 2         12 next LOOP1;
345             }
346             else
347             {
348 23         46 $dict->{V}->{value} = $value;
349             }
350              
351             # Set up display of form value
352 23 50       81 $dict->{AP} = CAM::PDF::Node->new('dictionary', {}, $objnum, $gennum) if (!$dict->{AP});
353 23 50       328 if (!$dict->{AP}->{value}->{N})
354             {
355 23         63 my $newobj = CAM::PDF::Node->new('object',
356             CAM::PDF::Node->new('dictionary',{}),
357             );
358 23         451 my $num = $self->appendObject(undef, $newobj, 0);
359 23         2432 $dict->{AP}->{value}->{N} = CAM::PDF::Node->new('reference', $num, $objnum, $gennum);
360             }
361             # my $formobj = $self->dereference($dict->{AP}->{value}->{N}->{value}); #JWT:CHGD. TO NEXT:
362             my $formobj = $self->dereference(($fieldType eq 'Btn')
363             ? $dict->{AP}->{value}->{N}->{value}->{Yes}->{value}
364 23 50       383 : $dict->{AP}->{value}->{N}->{value});
365 23         259 my $formonum = $formobj->{objnum};
366 23         39 my $formgnum = $formobj->{gennum};
367 23         48 my $formdict = $self->getValue($formobj);
368              
369 23 50       328 $formdict->{Subtype} = CAM::PDF::Node->new('label', 'Form', $formonum, $formgnum) if (!$formdict->{Subtype});
370 23         318 my @rect = (0,0,0,0);
371 23 50       68 if ($dict->{Rect})
372             {
373             ## no critic(Bangs::ProhibitNumberedNames)
374 23         54 my $r = $self->getValue($dict->{Rect});
375 23         230 my ($x1, $y1, $x2, $y2) = @{$r};
  23         54  
376 23         51 @rect = (
377             $self->getValue($x1),
378             $self->getValue($y1),
379             $self->getValue($x2),
380             $self->getValue($y2),
381             );
382             }
383 23         703 my $dx = $rect[2]-$rect[0];
384 23         53 my $dy = $rect[3]-$rect[1];
385 23 50       51 if (!$formdict->{BBox})
386             {
387 23         57 $formdict->{BBox} = CAM::PDF::Node->new('array',
388             [
389             CAM::PDF::Node->new('number', 0, $formonum, $formgnum),
390             CAM::PDF::Node->new('number', 0, $formonum, $formgnum),
391             CAM::PDF::Node->new('number', $dx, $formonum, $formgnum),
392             CAM::PDF::Node->new('number', $dy, $formonum, $formgnum),
393             ],
394             $formonum, $formgnum);
395             }
396 23         1310 my $text = $value;
397 23         49 $text =~ s/ \r\n? /\n/gxmso;
398 23         41 $text =~ s/ \n+\z //xmso;
399              
400 23         30 my @rsrcs;
401 23         34 my $fontmetrics = 0;
402 23         33 my $fontname = q{};
403 23         31 my $fontsize = 0;
404 23         31 my $da = q{};
405 23         31 my $tl = q{};
406             #JWT:CHGD TO NEXT PER BUG#122890: my $border = 2;
407 23         28 my $border = 1;
408 23         33 my $tx = $border;
409             #JWT:CHGD TO NEXT PER BUG#122890: my $ty = $border + 2;
410 23         32 my $ty = $border + 1;
411 23         26 my $stringwidth;
412 23 50       52 if ($propdict->{DA}) {
413 23         52 $da = $self->getValue($propdict->{DA});
414              
415             #print "--da=$da=\n";
416             # Try to pull out all of the resources used in the text object
417 23         296 @rsrcs = ($da =~ m{ /([^\s<>/\[\]()]+) }gxmso);
418              
419             # Try to pull out the font size, if any. If more than
420             # one, pick the last one. Font commands look like:
421             # "/ Tf"
422             #JWT: CHGD. TO NEXT (BUG#58144 PATCH): if ($da =~ m{ \s*/(\w+)\s+(\d+)\s+Tf.*? \z }xms)
423 23 50       147 if ($da =~ m{ \s*/([\w-]+)\s+([.\d]+)\s+Tf.*? \z }xmso)
424             {
425 23         60 $fontname = $1;
426 23         38 $fontsize = $2;
427             #print "--font: name=$fontname= sz=$fontsize= DR=".$propdict->{DR}."=\n";
428 23 50       47 if ($fontname)
429             {
430 23 50       55 if ($propdict->{DR})
431             {
432 0         0 my $dr = $self->getValue($propdict->{DR});
433 0         0 $fontmetrics = $self->getFontMetrics($dr, $fontname);
434             }
435             #print STDERR "Didn't get font\n" if (!$fontmetrics);
436             }
437             }
438             }
439              
440 23         53 my %flags = (
441             Justify => 'left',
442             );
443 23 100       60 if ($propdict->{Ff})
444             {
445             # Just decode the ones we actually care about
446             # PDF ref, 3rd ed pp 532,543
447 22         54 my $ff = $self->getValue($propdict->{Ff});
448 22         374 my @flags = split m//xms, unpack 'b*', pack 'V', $ff;
449 22         63 $flags{ReadOnly} = $flags[0];
450 22         42 $flags{Required} = $flags[1];
451 22         36 $flags{NoExport} = $flags[2];
452 22         49 $flags{Multiline} = $flags[12];
453 22         33 $flags{Password} = $flags[13];
454 22         41 $flags{FileSelect} = $flags[20];
455 22         44 $flags{DoNotSpellCheck} = $flags[22];
456 22         77 $flags{DoNotScroll} = $flags[23];
457             }
458 23 50       52 if ($propdict->{Q})
459             {
460 23   100     54 my $q = $self->getValue($propdict->{Q}) || 0;
461 23 100       251 $flags{Justify} = $q==2 ? 'right' : ($q==1 ? 'center' : 'left');
    100          
462             }
463             #print "-justify1=$flags{Justify}=\n";
464              
465             # The order of the following sections is important!
466 23 50       44 $text =~ s/ [^\n] /*/gxms if ($flags{Password}); # Asterisks for password characters
467              
468 23 50 33     55 if ($fontmetrics && ! $fontsize)
469             {
470             # Fix autoscale fonts
471 0         0 $stringwidth = 0;
472 0         0 my $lines = 0;
473 0         0 for my $line (split /\n/xmso, $text) # trailing null strings omitted
474             {
475 0         0 $lines++;
476 0         0 my $w = $self->getStringWidth($fontmetrics, $line);
477 0 0 0     0 $stringwidth = $w if ($w && $w > $stringwidth);
478             }
479 0   0     0 $lines ||= 1;
480             # Initial guess
481 0         0 $fontsize = ($dy - 2 * $border) / ($lines * 1.5);
482 0         0 my $fontwidth = $fontsize * $stringwidth;
483 0         0 my $maxwidth = $dx - 2 * $border;
484 0 0       0 $fontsize *= $maxwidth / $fontwidth if ($fontwidth > $maxwidth);
485 0         0 $da =~ s/ \/$fontname\s+0\s+Tf\b /\/$fontname $fontsize Tf/gxms;
486             }
487 23 50       55 if ($fontsize)
488             {
489             # This formula is TOTALLY empirical. It's probably wrong.
490             # #JWT:CHGD. TO NEXT: $ty = $border + 2 + (9 - $fontsize) * 0.4;
491 23         73 $ty = $border + 2 + (5 - $fontsize) * 0.4;
492             }
493              
494              
495             # escape characters
496 23         60 $text = $self->writeString($text);
497              
498 23 50       726 if ($flags{Multiline})
499             {
500             # TODO: wrap the field with wrapString()??
501             # Shawn Dawson of Silent Solutions pointed out that this does not auto-wrap the input text
502              
503 0         0 my $linebreaks = $text =~ s/ \\n /\) Tj T* \(/gxms;
504              
505             # Total guess work:
506             # line height is either 150% of fontsize or thrice
507             # the corner offset
508 0 0       0 $tl = $fontsize ? $fontsize * 1.5 : $ty * 3;
509              
510             # Bottom aligned
511             #$ty += $linebreaks * $tl;
512             # Top aligned
513 0         0 $ty = $dy - $border - $tl;
514 0 0       0 warn 'Justified text not supported for multiline fields' if ($flags{Justify} ne 'left');
515 0         0 $tl .= ' TL';
516             }
517             else
518             {
519             #JWT: CHGD. TO NEXT (BUG#58144 PATCH): if ($flags{Justify} ne 'left' && $fontmetrics)
520 23 100       54 if ($flags{Justify} ne 'left')
521             {
522             #JWT: CHGD. TO NEXT 8: my $width = $stringwidth || $self->getStringWidth($fontmetrics, $text);
523 13         19 my $width;
524 13 50 33     49 if ($stringwidth || $fontmetrics) {
525             #JWT:CHGD TO NEXT PER BUG#122890: $width = $self->getStringWidth($fontmetrics, $text);
526 0         0 $width = $self->getStringWidth($fontmetrics, (substr $text, 1, (length $text)-2));
527             } else { #JWT: NO FONT METRICS, SO HAVE TO GUESS WIDTH:
528 13         48 $width = (length($text)-1) * 0.57; #JWT:FIXME (HACK) FOR RIGHT-JUSTIFYING STANDARD SIZE 8 NUMERIC FONT.
529 13         25 my $commas = $text;
530 13         49 $width -= 0.29 while ($commas =~ s/\,//o); #JWT:FIXME (HACK) FUDGE FOR WIDTH OF COMMAS (SMALLER THAN DIGITS)
531             }
532 13         28 my $diff = $dx - $width * $fontsize;
533 13 50       26 $diff = 0 if ($diff < 0);
534              
535 13 100       39 if ($flags{Justify} eq 'center')
    50          
536             {
537 1         9 $text = ($diff/2)." 0 Td $text";
538             }
539             elsif ($flags{Justify} eq 'right')
540             {
541 12         75 $text = "$diff 0 Td $text";
542             #print "-justify3=text=$text= WIDTH=$width= FS=$fontsize= DX=$dx=\n";
543             }
544             }
545             }
546              
547             # Move text from lower left corner of form field
548 23         103 my $tm = "1 0 0 1 $tx $ty Tm ";
549              
550             # if not 'none', draw a background as a filled rectangle of solid color
551             my $background_color
552             = $opts{background_color} eq 'none' ? q{}
553 23 50       77 : ref $opts{background_color} ? "@{$opts{background_color}} rgb"
  0 50       0  
554             : "$opts{background_color} g";
555 23 50       139 my $background = $background_color ? "$background_color 0 0 $dx $dy re f" : q{};
556              
557 23         69 $text = "$tl $da $tm $text Tj";
558 23         132 $text = "$background /Tx BMC q 1 1 ".($dx-$border).q{ }.($dy-$border)." re W n BT $text ET Q EMC";
559 23 50       51 my $len = ($fieldType eq 'Btn') ? 0 : length($text); #JWT:CHANGED
560 23 50       46 unless ($fieldType eq 'Btn') #JWT:ADDED CONDITION:
561             {
562 23         67 $formdict->{Length} = CAM::PDF::Node->new('number', $len, $formonum, $formgnum);
563             # JWT:NEXT 3 ADDED PER BUG#125299 PATCH:
564 23         370 $formdict->{StreamData} = CAM::PDF::Node->new('stream', $text, $formonum, $formgnum);
565 23         291 delete $formdict->{ Filter };
566 23         61 $self-> encodeObject( $formonum, 'FlateDecode' );
567             }
568              
569 23 50       12170 if (@rsrcs > 0) {
570 23 50       89 $formdict->{Resources} = CAM::PDF::Node->new('dictionary', {}, $formonum, $formgnum) if (!$formdict->{Resources});
571 23         360 my $rdict = $self->getValue($formdict->{Resources});
572 23 50       202 if (!$rdict->{ProcSet})
573             {
574 23         57 $rdict->{ProcSet} = CAM::PDF::Node->new('array',
575             [
576             CAM::PDF::Node->new('label', 'PDF', $formonum, $formgnum),
577             CAM::PDF::Node->new('label', 'Text', $formonum, $formgnum),
578             ],
579             $formonum,$formgnum);
580             }
581 23 50       831 $rdict->{Font} = CAM::PDF::Node->new('dictionary', {}, $formonum, $formgnum) if (!$rdict->{Font});
582              
583 23         316 my $fdict = $self->getValue($rdict->{Font});
584              
585             # Search out font resources. This is a total kluge.
586             # TODO: the right way to do this is to look for the DR
587             # attribute in the form element or it's ancestors.
588 23         189 for my $font (@rsrcs)
589             {
590             #JWT: CHGD. TO NEXT 11 (BUG#58144 PATCH): my $fobj = $self->dereference("/$font", 'All');
591             #JWT: CHGD. TO NEXT 11 (BUG#58144 PATCH): if (!$fobj)
592 23         59 my $root = $self->getRootDict()->{AcroForm};
593 23         700 my $ifdict = $self->getValue($root);
594 23 50       759 if (!exists $ifdict->{DR})
595             {
596             #JWT:die "Could not find resource /$font while preparing form field $key\n";
597 0         0 warn "Could not find resource1 /$font while preparing form field $key\n";
598             }
599 23         48 my $dr = $self->getValue($ifdict->{DR});
600 23         216 my $fobjnum = $dr->{Font}->{value}->{$font}->{value};
601              
602 23 50       45 if (!$fobjnum)
603             {
604             #JWT:die "Could not find resource /$font while preparing form field $key\n";
605 0         0 warn "Could not find resource2 /$font while preparing form field $key\n";
606             }
607             #JWT: CHGD. TO NEXT (BUG#58144 PATCH): $fdict->{$font} = CAM::PDF::Node->new('reference', $fobj->{objnum}, $formonum, $formgnum);
608 23         54 $fdict->{$font} = CAM::PDF::Node->new('reference', $fobjnum, $formonum, $formgnum);
609             }
610             }
611             }
612 23         571 $filled++;
613             }
614              
615 12         59 return $filled;
616             }
617              
618             =item $doc->getFormFieldList()
619              
620             Return an array of the names of all of the PDF form fields. The names
621             are the full hierarchical names constructed as explained in the PDF
622             reference manual. These names are useful for the fillFormFields()
623             function.
624              
625             =cut
626              
627             sub getFormFieldList
628             {
629 220     220 1 241130 my $self = shift;
630 220         346 my $parentname = shift; # very optional
631              
632 220 100       505 my $prefix = (defined $parentname ? $parentname . q{.} : q{});
633              
634 220         327 my $kidlist;
635 220 100 66     777 if (defined $parentname && $parentname ne q{})
636             {
637 218         479 my $parent = $self->getFormField($parentname);
638 218 50       426 return if (!$parent);
639 218         416 my $dict = $self->getValue($parent);
640 218 100       2888 return if (!exists $dict->{Kids});
641 4         11 $kidlist = $self->getValue($dict->{Kids});
642             }
643             else
644             {
645 2         10 my $root = $self->getRootDict()->{AcroForm};
646 2 50       74 return if (!$root);
647 2         8 my $parent = $self->getValue($root);
648 2 50       3503 return if (!exists $parent->{Fields});
649 2         9 $kidlist = $self->getValue($parent->{Fields});
650             }
651              
652 6         50 my @list;
653 6         12 for my $kid (@{$kidlist})
  6         15  
654             {
655 218 50 33     1116 if ((! ref $kid) || (ref $kid) ne 'CAM::PDF::Node' || $kid->{type} ne 'reference')
      33        
656             {
657 0         0 die "Expected a reference as the form child of '$parentname'\n";
658             }
659 218         479 my $objnode = $self->dereference($kid->{value});
660 218         285920 my $dict = $self->getValue($objnode);
661 218         2821 my $name = '(no name)'; # assume the worst
662 218 50       686 $name = $self->getValue($dict->{T}) if (exists $dict->{T});
663 218         1876 $name = $prefix . $name;
664 218         924 $name =~ s/\x00//gso; #JWT:HANDLE IRS'S FSCKED-UP HIGH-ASCII FIELD NAMES!
665 218         499 push @list, $name;
666 218 50       445 push @list, $prefix . $self->getValue($dict->{TU}) . ' (alternate name)' if (exists $dict->{TU});
667 218         602 $self->{formcache}->{$name} = $objnode;
668 218         533 my @kidnames = $self->getFormFieldList($name);
669 218 100       602 if (@kidnames > 0)
670             {
671             #push @list, 'descend...';
672 4         75 push @list, @kidnames;
673             #push @list, 'ascend...';
674             }
675             }
676 6         197 return @list;
677             }
678              
679             =item $doc->getFormField($name)
680              
681             I
682              
683             Return the object containing the form field definition for the
684             specified field name. C<$name> can be either the full name or the
685             "short/alternate" name.
686              
687             =cut
688              
689             sub getFormField
690             {
691 246     246 1 406 my $self = shift;
692 246         356 my $fieldname = shift;
693              
694 246 50       487 return if (!defined $fieldname);
695              
696 246 50       528 if (! exists $self->{formcache}->{$fieldname})
697             {
698 0         0 my $kidlist;
699             my $parent;
700 0 0       0 if ($fieldname =~ m/ [.] /xms)
701             {
702 0         0 my $parentname;
703             #JWT: CHGD. TO NEXT (BUG#58144 PATCH): if ($fieldname =~ s/ \A(.*)[.]([.]+)\z /$2/xms)
704 0 0       0 $parentname = $1 if ($fieldname =~ s/ \A(.*)[.]([^.]+)\z /$2/xms);
705 0 0       0 return unless ($parentname);
706 0         0 $parent = $self->getFormField($parentname);
707 0 0       0 return unless ($parent);
708 0         0 my $dict = $self->getValue($parent);
709 0 0       0 return unless (exists $dict->{Kids});
710 0         0 $kidlist = $self->getValue($dict->{Kids});
711             }
712             else
713             {
714 0         0 my $root = $self->getRootDict()->{AcroForm};
715 0 0       0 return unless ($root);
716 0         0 $parent = $self->dereference($root->{value});
717 0 0       0 return unless ($parent);
718 0         0 my $dict = $self->getValue($parent);
719 0 0       0 return unless (exists $dict->{Fields});
720 0         0 $kidlist = $self->getValue($dict->{Fields});
721             }
722              
723 0         0 $self->{formcache}->{$fieldname} = undef; # assume the worst...
724 0         0 for my $kid (@{$kidlist})
  0         0  
725             {
726 0         0 my $objnode = $self->dereference($kid->{value});
727 0         0 $objnode->{formparent} = $parent;
728 0         0 my $dict = $self->getValue($objnode);
729 0 0       0 $self->{formcache}->{$self->getValue($dict->{T})} = $objnode if (exists $dict->{T});
730 0 0       0 $self->{formcache}->{$self->getValue($dict->{TU})} = $objnode if (exists $dict->{TU});
731             }
732             }
733              
734 246         473 return $self->{formcache}->{$fieldname};
735             }
736              
737             1;
738              
739             __END__