File Coverage

blib/lib/App/PDF/Link.pm
Criterion Covered Total %
statement 39 308 12.6
branch 0 156 0.0
condition 0 24 0.0
subroutine 13 25 52.0
pod 0 9 0.0
total 52 522 9.9


line stmt bran cond sub pod time code
1             #! perl
2              
3             package App::PDF::Link;
4              
5             # pdflink -- insert file links in PDF documents
6              
7             our $VERSION = '0.25';
8              
9             # Author : Johan Vromans
10             # Created On : Thu Sep 15 11:43:40 2016
11             # Last Modified By: Johan Vromans
12             # Last Modified On: Sat Jun 6 21:23:42 2020
13             # Update Count : 396
14             # Status : Unknown, Use with caution!
15              
16             ################ Common stuff ################
17              
18 1     1   56526 use strict;
  1         2  
  1         24  
19 1     1   5 use warnings;
  1         1  
  1         20  
20 1     1   558 use utf8;
  1         12  
  1         4  
21 1     1   27 use Carp;
  1         1  
  1         43  
22 1     1   395 use App::Packager;
  1         1944  
  1         4  
23              
24             ################ The Process ################
25              
26 1     1   481 use App::PDF::Link::Icons;
  1         2  
  1         51  
27 1     1   764 use PDF::API2 2.029;
  1         189153  
  1         33  
28 1     1   8 use Encode qw (encode_utf8 decode_utf8 );
  1         3  
  1         62  
29              
30             sub run {
31 0     0 0   my ( $pkg, $env ) = @_;
32              
33 1     1   425 use PDF::API2::Annotation;
  1         1521  
  1         65  
34              
35 0 0         if ( $env->{embed} <= 1 ) {
36             die("No attachment support??")
37             unless PDF::API2::Annotation->can( $env->{embed}
38 0 0         ? "fileattachment"
    0          
39             : "file" );
40             }
41             else {
42 0 0         die("No embedding support??")
43             unless PDF::API2->can("embeddedfile");
44             }
45              
46 1     1   7 use PDF::API2::Page;
  1         2  
  1         1412  
47 0           *PDF::API2::Page::annotation =
48             *PDF::API2::Page::annotation_xx;
49              
50 0 0         if ( @{ $env->{targets} } ) {
  0            
51             linktargets( $env, $_, $env->{targets} )
52 0           foreach @ARGV;
53             }
54             else {
55 0           linkit( $env );
56             }
57             }
58              
59             ################ Subroutines ################
60              
61             sub linktargets {
62 0     0 0   my $env = shift;
63 0           my ( $pdf, $pageno, $pdfname, $targets, @targets );
64 0           my ( $v, $d, $p );
65              
66 0 0         if ( @_ == 2 ) {
    0          
67 0           ( $pdfname, $targets ) = @_;
68              
69 0 0         warn("Loading PDF $pdfname...\n") if $env->{verbose};
70 0 0         $pdf = PDF::API2->open($pdfname)
71             or die("$pdfname: $!\n");
72              
73 0           ( $v, $d, $p ) = File::Spec->splitpath($pdfname);
74 0           my $pp = $p;
75 0           $pp =~ s/\.pdf$//i;
76              
77 0           @targets = @$targets;
78 0           foreach ( @targets ) {
79 0 0         $_ = $pp . $_ if /^\.\w+$/;
80             }
81 0           $pageno = 1;
82             }
83             elsif ( @_ == 3 ) {
84 0           ( $pdf, $pageno, $targets ) = @_;
85 0           @targets = @$targets;
86             }
87             else {
88 0           die("Internal error -- wrong args to linktargets\n");
89             }
90              
91 0           my $page; # the current page
92             my $text; # text content
93 0           my $gfx; # graphics content
94 0           my $x; # current x for icon
95 0           my $y; # current y for icon
96 0           my $did;
97 0           my $embed = $env->{embed}; # 0 = linked
98             # 1 = embedded
99             # 2 = attached
100 0           my $action = ( qw( linked embedded attached ) )[$embed];
101              
102 0           foreach ( @targets ) {
103 0 0         unless ( -r $_ ) {
104 0           warn("\tTarget: ", encode_utf8($_), " missing (skipped)\n");
105 0           next;
106             }
107 0           $did++;
108              
109 0   0       my $t = substr( $_, length(File::Spec->catpath($v, $d||"", "") ) );
110 0           ( my $ext = $t ) =~ s;^.*\.(\w+)$;$1;;
111 0           my $p = get_icon( $env, $pdf, $ext );
112 0 0         unless ( $p ) {
113 0           warn("\tFile: ", encode_utf8($t), " (ignored)\n");
114 0           next;
115             }
116              
117 0           warn("\tFile: ", encode_utf8($t), " ($action)\n");
118              
119 0 0         if ( $action eq "attached" ) {
120             # Separate objects, no coordinate problems.
121 0           $pdf->embeddedfile( $t );
122 0           next;
123             }
124              
125 0           my $dx = $env->{iconsz} + $env->{padding};
126 0           my $dy = $env->{iconsz} + $env->{padding};
127              
128 0 0         unless ( $page ) {
129 0           $page = $pdf->openpage($pageno);
130 0           my @m = $page->get_mediabox;
131 0 0         if ( $env->{xpos} >= 0 ) {
132 0           $x = $m[0] + $env->{xpos};
133             }
134             else {
135 0           $x = $m[2] + $env->{xpos} - $env->{iconsz};
136 0 0         $dx = -$dx unless $env->{vertical};
137             }
138 0 0         if ( $env->{ypos} >= 0 ) {
139 0           $y = $m[3] - $env->{ypos} - $env->{iconsz};
140             }
141             else {
142 0           $y = $m[1] - $env->{ypos};
143 0 0         $dy = -$dy if $env->{vertical};
144             }
145              
146 0           $text = $page->text;
147             ####WARNING: Coordinates may be wrong!
148             # The graphics context uses the user transformations
149             # currently in effect. If these were not neatly restored,
150             # the graphics may be misplaced/scaled.
151             # By using --gfunder, the images are placed behind the page
152             # but this only works for transparent pages.
153 0 0         $gfx = $page->gfx( $embed ? 0 : $env->{gfunder} );
154             }
155              
156 0           my $border = $env->{border};
157 0           my @r = ( $x, $y, $x + $env->{iconsz}, $y + $env->{iconsz} );
158              
159 0 0         if ( $action eq "embedded" ) {
160             # This always uses the right coordinates.
161 0           my $ann = $page->annotation_xx;
162 0           $ann->fileattachment( $t,
163             -text => "$t $action by pdflink $VERSION",
164             -icon => $p,
165             -rect => \@r );
166             }
167             else {
168 0           my $ann = $page->annotation_xx;
169 0           $ann->file( $t, -rect => \@r );
170 0           my $scale = $env->{iconsz} / $p->width;
171 0           $gfx->image( $p, @r[0,1], $scale );
172             }
173              
174 0 0         if ( $env->{border} ) {
175 0           $gfx->rectxy(@r );
176 0           $gfx->stroke;
177             }
178              
179             # Next link.
180 0 0         if ( $env->{vertical} ) {
181 0           $y -= $dy;
182             }
183             else {
184 0           $x += $dx;
185             }
186             }
187 0 0         return unless $pdfname;
188              
189             # Finish PDF document.
190 0 0         if ( $env->{output} ) {
    0          
191 0 0         warn("Writing PDF ", $env->{output}, " ...\n") if $env->{verbose};
192 0           $pdf->saveas($env->{output});
193 0 0         warn("Wrote: ", $env->{output}, "\n") if $env->{verbose};
194             }
195             elsif ( $did ) {
196 0 0         warn("Updating PDF $pdfname...\n") if $env->{verbose};
197 0           $pdf->update;
198 0 0         warn("Wrote: $pdfname\n") if $env->{verbose};
199             }
200             else {
201 0 0         warn("Not modified: $pdfname\n") if $env->{verbose};
202             }
203             }
204              
205             sub linkit {
206 0     0 0   my $env = shift;
207              
208 0           require Text::CSV_XS;
209 0           require File::Spec;
210 0           require File::Glob;
211              
212 0           my ( $pdfname, $csvname ) = @ARGV;
213 0 0         unless ( $csvname ) {
214 0           ( $csvname = $pdfname ) =~ s/\.pdf$/.csv/i;
215             }
216 0   0       $env->{output} ||= "__new__.pdf";
217              
218 0 0         warn("Loading PDF $pdfname...\n") if $env->{verbose};
219 0 0         my $pdf = PDF::API2->open($pdfname)
220             or die("$pdfname: $!\n");
221              
222 0           my ( $v, $d, $p ) = File::Spec->splitpath($pdfname);
223 0           my $pp = $p;
224 0           $pp =~ s/\.pdf$//i;
225              
226             # Read/parse CSV.
227 0 0         warn("Loading CSV $csvname...\n") if $env->{verbose};
228 0           my $csv = Text::CSV_XS->new( { binary => 1,
229             sep_char => ";",
230             empty_is_undef => 1,
231             auto_diag => 1 });
232 0 0         open( my $fh, "<:encoding(utf8)", $csvname )
233             or die("$csvname: $!\n");
234              
235 0           my $i_title;
236             my $i_pages;
237 0           my $i_xpos;
238 0           my $i_ypos;
239 0           my $row = $csv->getline($fh);
240 0           for ( my $i = 0; $i < @$row; $i++ ) {
241 0 0         next unless defined $row->[$i];
242 0 0         $i_title = $i if lc($row->[$i]) eq "title";
243 0 0         $i_pages = $i if lc($row->[$i]) eq "pages";
244 0 0         $i_xpos = $i if lc($row->[$i]) eq "xpos";
245 0 0         $i_ypos = $i if lc($row->[$i]) eq "ypos";
246             }
247 0 0         die("Invalid info in $csvname. missing TITLE\n")
248             unless defined $i_title;
249 0 0         die("Invalid info in $csvname. missing PAGES\n")
250             unless defined $i_pages;
251              
252 0 0         warn("Processing CSV entries...\n") if $env->{verbose};
253 0           while ( $row = $csv->getline($fh)) {
254 0           my $title = $row->[$i_title];
255 0           my $pageno = $row->[$i_pages];
256 0 0         $pageno = $1 if $pageno =~ /^(\d+)/;
257 0 0         warn("Page: $pageno, ", encode_utf8($title), "\n") if $env->{verbose};
258              
259 0           my $t = $title;
260 0           $t =~ s;[:/];@;g; # eliminate dangerous characters
261 0 0         $t =~ s;["<>?\\|*];@;g if $^O =~ /win/i; # eliminate dangerous characters
262              
263 0           my @files = File::Glob::bsd_glob( File::Spec->catpath($v, $d, "$t.*" ) );
264 0           linktargets( $env, $pdf, $pageno, \@files );
265              
266             }
267 0           close $fh;
268              
269             # Finish PDF document.
270 0 0         warn("Writing PDF ", $env->{output}, " ...\n") if $env->{verbose};
271 0           $pdf->saveas($env->{output});
272 0 0         warn("Wrote: ", $env->{output}, "\n") if $env->{verbose};
273             }
274              
275             ################ Options and Configuration ################
276              
277 1     1   638 use Getopt::Long 2.13;
  1         8758  
  1         19  
278 1     1   119 use File::Spec;
  1         2  
  1         18  
279 1     1   4 use Carp;
  1         2  
  1         1826  
280              
281             # Package name.
282             my $my_package;
283             # Program name and version.
284             my ($my_name, $my_version);
285              
286             sub app_setup {
287 0     0 0   my ( $pkg, $appname, $appversion, %args ) = @_;
288 0           my $help = 0; # handled locally
289 0           my $ident = 0; # handled locally
290 0           my $man = 0; # handled locally
291              
292             # Package name.
293 0           $my_package = $args{package};
294             # Program name and version.
295 0 0         if ( defined $appname ) {
296 0           ($my_name, $my_version) = ($appname, $appversion);
297             }
298             else {
299 0           ($my_name, $my_version) = qw( MyProg 0.01 );
300             }
301              
302 0           my $options =
303             {
304             output => undef, # output pdf
305             embed => undef, # link, embed or attach
306             all => 0, # link all files
307             xpos => 60, # position of icons
308             ypos => 60, # position of icons
309             padding => 0, # padding between icons
310             iconsz => 50, # desired icon size
311             icons => {}, # additional icons
312             vertical => undef, # stacking of icons
313             border => 0, # draw borders around icon
314             gfunder => 0, # draw images behind the page
315             targets => [], # explicit link targets
316             verbose => 0, # verbose processing
317             ### ADD OPTIONS HERE ###
318              
319             # Development options (not shown with -help).
320             debug => 0, # debugging
321             trace => 0, # trace (show process)
322              
323             # Service.
324             _package => $my_package,
325             _name => $my_name,
326             _version => $my_version,
327             _stdin => \*STDIN,
328             _stdout => \*STDOUT,
329             _stderr => \*STDERR,
330             _argv => [ @ARGV ],
331             };
332              
333             my $pod2usage = sub {
334             # Load Pod::Usage only if needed.
335 0     0     require Pod::Usage;
336 0           my $f = __FILE__;
337 0 0         if ( $App::Packager::PACKAGED ) {
338 0           $f = App::Packager::GetResource("pod/pdflink.pod");
339 0           unshift( @_, -noperldoc => 1 );
340             }
341 0           unshift( @_, -input => $f );
342 0           &Pod::Usage::pod2usage;
343 0           };
344              
345             # Collect command line options in a hash, for they will be needed
346             # later.
347 0           my $clo = { embed => 0 };
348              
349             # Sorry, layout is a bit ugly...
350 0 0         if ( !GetOptions
351             ($clo,
352              
353             ### ADD OPTIONS HERE ###
354             'output|pdf=s',
355             'embed',
356 0     0     'attach' => sub { $clo->{embed} = 2 },
357             'all',
358             'xpos=i',
359             'ypos=i',
360             'iconsz|iconsize|icon=i',
361             'icons=s%',
362             'padding=i',
363             'vertical',
364             'border',
365             'gfunder',
366             'targets|t=s@',
367              
368             # Standard options.
369             'ident' => \$ident,
370             'help|?' => \$help,
371             'manual' => \$man,
372             'verbose|v',
373             'trace',
374             'debug',
375 0     0     'version' => sub { app_ident(\*STDOUT); exit },
  0            
376             ) )
377             {
378 0           $pod2usage->(2);
379             }
380             # GNU convention: message to STDOUT upon request.
381 0 0 0       app_ident(\*STDOUT) if $ident or $help;
382 0 0 0       if ( $man or $help ) {
383 0 0         $pod2usage->(1) if $help;
384 0 0         $pod2usage->(VERBOSE => 2) if $man;
385             }
386              
387             # Plug in command-line options.
388 0           @{$options}{keys %$clo} = values %$clo;
  0            
389              
390 0 0         if ( @{ $options->{targets} } ) {
  0            
391 0           @{ $options->{targets} } = split( /[;,]/, join(":", @{ $options->{targets} }) );
  0            
  0            
392 0 0         $pod2usage->(1) unless @ARGV;
393 0 0 0       $pod2usage->(1) if $options->{pdf} && @ARGV > 1;
394             }
395             else {
396 0 0 0       $pod2usage->(1) if @ARGV < 1 || @ARGV > 2;
397             }
398              
399 0           $options;
400             }
401              
402             sub app_ident {
403 0     0 0   my ($fh) = @_;
404 0 0         print {$fh} ("This is ",
  0            
405             $my_package
406             ? "$my_package [$my_name $my_version]"
407             : "$my_name version $my_version",
408             "\n");
409             }
410              
411             =head1 NAME
412              
413             pdflink - insert document links in PDF
414              
415             =head1 SYNOPSIS
416              
417             pdflink [options] pdf-file [csv-file]
418              
419             pdflink [options] --targets=file1;file2 pdf-file [pdf-file ...]
420              
421             Inserts document links in PDF
422              
423             Options:
424             --output=XXX name of the new PDF (default __new__.pdf)
425             --embed embed the data files instead of linking
426             --attach attach the data files instead of linking
427             --xpos=NN X-position for links
428             --ypos=NN Y-position for links relative to top
429             --iconsize=NN size of the icons, default 50
430             --icons=type=XXX add icon image XXX for this type
431             --padding=NN padding between icons, default 0
432             --vertical stacks icons vertically
433             --border draws a border around the links
434             --gfunder draws the images behind the page
435             --targets=XXX specifies the target(s) to link to
436             --ident shows identification
437             --help shows a brief help message and exits
438             --man shows full documentation and exits
439             --verbose provides more verbose information
440              
441             =head1 DESCRIPTION
442              
443             When invoked without a B<--targets> option, this program will process
444             the PDF document using the associated CSV as table of contents.
445              
446             For every item in the PDF that has one or more additional files (files
447             with the same name as the title, but differing extensions), clickable
448             icons are added to the first page of the item. When clicked in a
449             suitable PDF viewing tool, the corrresponding file will be activated.
450              
451             For example, if the CSV contains
452              
453             title;pages;
454             Blue Moon;24;
455              
456             And the following files are present in the current directory
457              
458             Blue Moon.html
459             Blue Moon.mscz
460              
461             Then two clickable icons will be added to page 24 of the document,
462             leading to these two files.
463              
464             Upon completion, the updated PDF is written out under the specified name.
465              
466             When invoked with the B<--targets> option, all specified PDF files get
467             links inserted to the targets on the first page. If there is only one
468             PDF file you can use the B<--pdf> option to designate the name of the
469             new PDF document, otherwise all PDF files are updated (rewritten.
470              
471             =head1 OPTIONS
472              
473             Note that all sizes and dimensions are in I (72 points per inch).
474              
475             =over 8
476              
477             =item B<--pdf=>I
478              
479             Specifies the updated PDF to be written.
480              
481             =item B<--embed>
482              
483             Normally links are inserted into the PDF document that point to files
484             on disk. To use the links from the PDF document, the target files must
485             exist on disk.
486              
487             With B<--embed>, the target files are embedded (as file attachments)
488             to the PDF document. The resultant PDF document will be usable on its
489             own, no other files needed.
490              
491             =item B<--attach>
492              
493             This is similar to B<--embed>, but the files are attached to the PDF
494             document and no icons are placed on the pages.
495              
496             =item B<--all>
497              
498             Normally, only files with known types (extensions) are taken into
499             account. Currently, these are C for iRealPro, C for
500             MuseScore, C for Sibelius, C and C for MusicXML,
501             C for ABC and C for generic XML documents.
502              
503             With B<--all>, all files that have matching names will be processed.
504             However, files with unknown extensions will get a neutral document
505             icon.
506              
507             =item B<--xpos=>I
508              
509             Horizontal position of the icons.
510              
511             If the value is positive, icon placement starts relative to the left
512             side of the page.
513              
514             If the value is negative, icon placement starts relative to the right
515             side of the page.
516              
517             Default is 0 (zero); icon placement begins against the left side of
518             the page.
519              
520             Icons are always placed from the outside of the page towards the
521             inner side.
522              
523             An I value may also be specified in the CSV file, in a column
524             with title C. If present, this value is added to position
525             resulting from the command line / default values.
526              
527             =item B<--ypos=>I
528              
529             If the value is positive, icon placement starts relative to the top
530             of the page.
531              
532             If the value is negative, icon placement starts relative to the bottom
533             of the page.
534              
535             Default is 0 (zero); icon placement begins against the top of the
536             page.
537              
538             Icons are always placed from the outside of the page towards the
539             inner side.
540              
541             An I offset value may also be specified in the CSV file, in a
542             column with title C. If present, this value is added to position
543             resulting from the command line / default values. This is especially
544             useful if there are songs in the PDF that do not start at the top of
545             the page, e.g., when there are multiple songs on a single page.
546              
547             =item B<--iconsize=>I
548              
549             Desired size of the link icons. Default is 50.
550              
551             =item B<--padding=>I
552              
553             Space between icons. Default is to place the icons adjacent to each
554             other.
555              
556             =item B<--vertical>
557              
558             Stacks the icons vertically.
559              
560             =item B<--border>
561              
562             Requests a border to be drawn around the links.
563              
564             Borders are always drawn for links without icons.
565              
566             =item B<--gfunder>
567              
568             Drawing the icon images uses the page transformations in effect at the
569             end of the page. If these were not neatly restored, the graphics may
570             be misplaced/scaled/flipped.
571              
572             By using B<--gfunder>, the images are placed behind the page
573             but this only works for transparent pages.
574              
575             This option is only relevant when adding links to external files. With
576             B<--embed> the problem does not occur.
577              
578             =item B<--targets=>I [ B<;> I ... ]
579              
580             Explicitly specifies the target files to link to. In this case no CSV
581             is processed and the input PDF(s) are updated (rewritten) unless
582             B<--pdf> is used to designate the output PDF name.
583              
584             =item B<--help>
585              
586             Prints a brief help message and exits.
587              
588             =item B<--man>
589              
590             Prints the manual page and exits.
591              
592             =item B<--ident>
593              
594             Prints program identification.
595              
596             =item B<--version>
597              
598             Prints program identification and exits.
599              
600             =item B<--verbose>
601              
602             Provides more verbose information.
603              
604             =item I
605              
606             The directory to process. Defaults to the current directory.
607              
608             =back
609              
610             =head1 ICONS
611              
612             B has a number of icons built-in for common file types.
613             Associations between a filename extension and an icon can be made with
614             the B<--icons> command line option.
615              
616             For example,
617              
618             --icons=pdf=builtin:PDF
619              
620             This will associate the built-in icon PDF with filename extension C.
621              
622             Alternatively, an image file may be specified to add user defined icons.
623              
624             --icons=pdf=builtin:myicons/pdficon.png
625              
626             The following icons are built-in. By default, only MuseScore and
627             iRealPro icons are associated and all other filename extensions will
628             be skipped. When pdflink is run with command line option B<--all>, all
629             built-in icons will be associated and all matching files will get
630             linked.
631              
632             =over
633              
634             =item PDF
635              
636             Associated to filename extension C (generic PDF document).
637              
638             =item PNG
639              
640             Associated to filename extension C (PNG image).
641              
642             =item JPG
643              
644             Associated to filename extensions C and C (JPG image).
645              
646             =item MuseScore
647              
648             Associated to filename extension C (MuseScore document).
649              
650             =item iRealPro
651              
652             Associated to filename extension C (iRealPro link in HTML document).
653              
654             While technically this is wrong, this is the way iRealPro data is
655             handled on Android and iPad.
656              
657             =item BandInABox
658              
659             Associated to filename extensions C, C and so on (Band-In-A-Box document).
660              
661             =item MXL
662              
663             Associated with filename extension C and C (MusicXML).
664              
665             =item XML
666              
667             Associated with filename extension C (generic XML document).
668              
669             =item Document
670              
671             Fallback icon for unknown filename extensions.
672              
673             =item Border
674              
675             Alternative fallback icon for unknown filename extensions.
676              
677             =back
678              
679             =head1 LIMITATIONS
680              
681             Some PDF files cannot be processed. If this happens, try converting
682             the PDF to PDF-1.4 or PDF/A.
683              
684             Files with extension B are assumed to be iRealPro files and will
685             get the iRealPro icon.
686              
687             Unknown extensions will get an empty square box instead of an icon.
688              
689             Since colon C<:> and slash C are not allowed in file names, they
690             are replaced with C<@> characters.
691              
692             If the icons come out at the wrong place or upside down, try
693             B<--gfunder>.
694              
695             =head1 AUTHOR
696              
697             Johan Vromans Ejvromans@squirrel.nlE
698              
699             =head1 COPYRIGHT
700              
701             Copyright 2016,2020 Johan Vromans. All rights reserved.
702              
703             This module is free software. You can redistribute it and/or
704             modify it under the terms of the Artistic License 2.0.
705              
706             This program is distributed in the hope that it will be useful,
707             but without any warranty; without even the implied warranty of
708             merchantability or fitness for a particular purpose.
709              
710             =cut
711              
712             ################ Patches ################
713              
714             package PDF::API2::Page;
715              
716             sub annotation_xx {
717 0     0 0   my ($self, $type, $key, $obj) = @_;
718              
719 0   0       $self->{'Annots'}||=PDFArray();
720 0 0         $self->{'Annots'}->realise if(ref($self->{'Annots'})=~/Objind/);
721 0 0         if($self->{'Annots'}->is_obj($self->{' apipdf'}))
722             {
723             # $self->{'Annots'}->update();
724             }
725             else
726             {
727 0           $self->update();
728             }
729              
730 0           my $ant=PDF::API2::Annotation->new;
731 0           $self->{'Annots'}->add_elements($ant);
732 0           $self->{' apipdf'}->new_obj($ant);
733 0           $ant->{' apipdf'}=$self->{' apipdf'};
734 0           $ant->{' apipage'}=$self;
735              
736 0 0         if($self->{'Annots'}->is_obj($self->{' apipdf'}))
737             {
738 0           $self->{' apipdf'}->out_obj($self->{'Annots'});
739             }
740              
741 0           return($ant);
742             }
743              
744             package PDF::API2::Annotation;
745              
746             #=item $ant->fileattachment $file, %opts
747             #
748             #Defines the annotation as a file attachment with file $file and
749             #options %opts (-rect, -border, -content (type), -icon (name), -text (comment)).
750             #
751             #=cut
752              
753             sub fileattachment {
754 0     0 0   my ( $self, $file, %opts ) = @_;
755              
756 0           my $icon;
757 0 0 0       $icon = $opts{-icon} || 'PushPin' if exists $opts{-icon};
758 0 0         my @r = @{ $opts{-rect} } if defined $opts{-rect};
  0            
759 0 0         my @b = @{ $opts{-border} } if defined $opts{-border};
  0            
760              
761 0           $self->{Subtype} = PDFName('FileAttachment');
762 0 0         $self->{T} = PDFStr($opts{"-text"}) if exists($opts{"-text"});
763              
764 0 0         if ( is_utf8($file)) {
765             # URI must be 7-bit ascii
766 0           utf8::downgrade($file);
767             }
768              
769             # 9 0 obj <<
770             # /Type /Annot
771             # /Subtype /FileAttachment
772             # /Name /PushPin
773             # /C [ 1 1 0 ]
774             # /Contents (test.txt)
775             # /FS <<
776             # /Type /F
777             # /EF << /F 10 0 R >>
778             # /F (test.txt)
779             # >>
780             # /Rect [ 100 100 200 200 ]
781             # /Border [ 0 0 1 ]
782             # >> endobj
783             #
784             # 10 0 obj <<
785             # /Type /EmbeddedFile
786             # /Length ...
787             # >> stream
788             # ...
789             # endstream endobj
790              
791 0           $self->{Contents} = PDFStr($file);
792             # Name will be ignored if there is an AP.
793 0 0 0       $self->{Name} = PDFName($icon) if $icon && !ref($icon);
794             # $self->{F} = PDFNum(0b0);
795 0           $self->{C} = PDFArray( map { PDFNum($_) } 1, 1, 0 );
  0            
796              
797             # The File Specification.
798 0           $self->{FS} = PDFDict();
799 0           $self->{FS}->{F} = PDFStr($file);
800 0           $self->{FS}->{Type} = PDFName('F');
801 0           $self->{FS}->{EF} = PDFDict($file);
802 0           $self->{FS}->{EF}->{F} = PDFDict($file);
803 0           $self->{' apipdf'}->new_obj($self->{FS}->{EF}->{F});
804 0           $self->{FS}->{EF}->{F}->{Type} = PDFName('EmbeddedFile');
805 0           $self->{FS}->{EF}->{F}->{' streamfile'} = $file;
806              
807             # Set the annotation rectangle and border.
808 0 0         $self->rect(@r) if @r;
809 0 0         $self->border(@b) if @b;
810              
811             # Set the appearance.
812 0 0         $self->appearance($icon, %opts) if $icon;
813              
814 0           return($self);
815             }
816              
817             sub appearance {
818 0     0 0   my ( $self, $icon, %opts ) = @_;
819              
820 0 0         return unless $self->{Subtype}->val eq 'FileAttachment';
821              
822 0 0         my @r = @{ $opts{-rect}} if defined $opts{-rect};
  0            
823 0 0         die "insufficient -rect parameters to annotation->appearance( ) "
824             unless(scalar @r == 4);
825              
826             # Handle custom icon type 'None'.
827 0 0         if ( $icon eq 'None' ) {
    0          
828             # It is not clear what viewers will do, so provide an
829             # appearance dict with no graphics content.
830              
831             # 9 0 obj <<
832             # ...
833             # /AP << /D 11 0 R /N 11 0 R /R 11 0 R >>
834             # ...
835             # >>
836             # 11 0 obj <<
837             # /BBox [ 0 0 100 100 ]
838             # /FormType 1
839             # /Length 6
840             # /Matrix [ 1 0 0 1 0 0 ]
841             # /Resources <<
842             # /ProcSet [ /PDF ]
843             # >>
844             # >> stream
845             # 0 0 m
846             # endstream endobj
847              
848 0           $self->{AP} = PDFDict();
849 0           my $d = PDFDict();
850 0           $self->{' apipdf'}->new_obj($d);
851 0           $d->{FormType} = PDFNum(1);
852 0           $d->{Matrix} = PDFArray( map { PDFNum($_) } 1, 0, 0, 1, 0, 0 );
  0            
853 0           $d->{Resources} = PDFDict();
854 0           $d->{Resources}->{ProcSet} = PDFArray( map { PDFName($_) } qw(PDF));
  0            
855 0           $d->{BBox} = PDFArray( map { PDFNum($_) } 0, 0, $r[2]-$r[0], $r[3]-$r[1] );
  0            
856 0           $d->{' stream'} = "0 0 m";
857 0           $self->{AP}->{N} = $d; # normal appearance
858             # Should default to N, but be sure.
859 0           $self->{AP}->{R} = $d; # Rollover
860 0           $self->{AP}->{D} = $d; # Down
861             }
862              
863             # Handle custom icon.
864             elsif ( ref $icon ) {
865             # Provide an appearance dict with the image.
866              
867             # 9 0 obj <<
868             # ...
869             # /AP << /D 11 0 R /N 11 0 R /R 11 0 R >>
870             # ...
871             # >>
872             # 11 0 obj <<
873             # /BBox [ 0 0 1 1 ]
874             # /FormType 1
875             # /Length 13
876             # /Matrix [ 1 0 0 1 0 0 ]
877             # /Resources <<
878             # /ProcSet [ /PDF /Text /ImageB /ImageC /ImageI ]
879             # /XObject << /PxCBA 7 0 R >>
880             # >>
881             # >> stream
882             # q /PxCBA Do Q
883             # endstream endobj
884              
885 0           $self->{AP} = PDFDict();
886 0           my $d = PDFDict();
887 0           $self->{' apipdf'}->new_obj($d);
888 0           $d->{FormType} = PDFNum(1);
889 0           $d->{Matrix} = PDFArray( map { PDFNum($_) } 1, 0, 0, 1, 0, 0 );
  0            
890 0           $d->{Resources} = PDFDict();
891 0           $d->{Resources}->{ProcSet} = PDFArray( map { PDFName($_) } qw(PDF Text ImageB ImageC ImageI));
  0            
892 0           $d->{Resources}->{XObject} = PDFDict();
893 0           my $im = $icon->{Name}->val;
894 0           $d->{Resources}->{XObject}->{$im} = $icon;
895             # Note that the image is scaled to one unit in user space.
896 0           $d->{BBox} = PDFArray( map { PDFNum($_) } 0, 0, 1, 1 );
  0            
897 0           $d->{' stream'} = "q /$im Do Q";
898 0           $self->{AP}->{N} = $d; # normal appearance
899              
900 0           if ( 0 ) {
901             # Testing... Provide an alternative for R and D.
902             # Works only with Adobe Reader.
903             $d = PDFDict();
904             $self->{' apipdf'}->new_obj($d);
905             $d->{Type} = PDFName('XObject');
906             $d->{Subtype} = PDFName('Form');
907             $d->{FormType} = PDFNum(1);
908             $d->{Matrix} = PDFArray( map { PDFNum($_) } 1, 0, 0, 1, 0, 0 );
909             $d->{Resources} = PDFDict();
910             $d->{Resources}->{ProcSet} = PDFArray( map { PDFName($_) } qw(PDF));
911             $d->{BBox} = PDFArray( map { PDFNum($_) } 0, 0, $r[2]-$r[0], $r[3]-$r[1] );
912             $d->{' stream'} =
913             join( " ",
914             # black outline
915             0, 0, 'm',
916             0, $r[2]-$r[0], 'l',
917             $r[2]-$r[0], $r[3]-$r[1], 'l',
918             $r[2]-$r[0], 0, 'l',
919             's',
920             );
921             }
922              
923             # Should default to N, but be sure.
924 0           $self->{AP}->{R} = $d; # Rollover
925 0           $self->{AP}->{D} = $d; # Down
926             }
927              
928 0           return $self;
929             }
930              
931             package PDF::API2;
932              
933             #=item $pdf->embeddedfile $file, %opts
934             #
935             #Adds a file attachment to the document.
936             #
937             #=cut
938              
939             sub embeddedfile {
940 0     0 0   my ( $self, $file, %opts ) = @_;
941              
942 0 0         if ( is_utf8($file)) {
943             # URI must be 7-bit ascii
944 0           utf8::downgrade($file);
945             }
946              
947             # The File Specification.
948 0           my $fs = PDFDict();
949 0           $fs->{Type} = PDFName('Filespec');
950              
951 0           $fs->{F} = PDFStr($file);
952 0           $fs->{UF} = PDFStr( Encode::encode( 'UTF16-BE', "\x{FEFF}$file" ) );
953 0           $fs->{Desc} = PDFStr("$file attached by pdflink $VERSION");
954              
955 0           $fs->{EF} = PDFDict($file);
956 0           $fs->{EF}->{F} = PDFDict($file);
957 0           $self->{pdf}->new_obj($fs->{EF}->{F});
958 0           $fs->{EF}->{F}->{Type} = PDFName('EmbeddedFile');
959 0           $fs->{EF}->{F}->{' streamfile'} = $file;
960 0           $self->{pdf}->new_obj($fs);
961 0           my $nd = $self->named_destination( 'EmbeddedFiles', $file, $fs );
962 0           $self->{'pdf'}->out_obj($self->{catalog});
963              
964 0           return($self);
965             }
966              
967             =head1 AUTHOR
968              
969             Johan Vromans C<< >>
970              
971             =head1 SUPPORT
972              
973             PDFlink development is hosted on GitHub, repository
974             L.
975              
976             Please report any bugs or feature requests to the GitHub issue tracker,
977             L.
978              
979             =cut
980              
981             1;