Fri Nov 04 03:16:38 2016 jv [...] cpan.org - Correspondence added
I forgot about this one... I've done a lot of development since and I have attached a much improved version. This version has proper appearance handling, and handles custom icons.
"file_attachment" means to me that it is going to file away (action) an attachment. "fileattachment" is a noun, which corresponds better to what it is. At least I think so, but it is probably not worth the discussion.
Subject: fileattachment.pl
sub fileattachment {
my ( $self, $file, %opts ) = @_;
my $icon = $opts{-icon} || 'PushPin';
my @r = @{ $opts{-rect} } if defined $opts{-rect};
my @b = @{ $opts{-border} } if defined $opts{-border};
$self->{Subtype} = PDFName('FileAttachment');
if ( is_utf8($file)) {
# URI must be 7-bit ascii
utf8::downgrade($file);
}
# 9 0 obj <<
# /Type /Annot
# /Subtype /FileAttachment
# /Name /PushPin
# /C [ 1 1 0 ]
# /Contents (test.txt)
# /FS <<
# /Type /F
# /EF << /F 10 0 R >>
# /F (test.txt)
# >>
# /Rect [ 100 100 200 200 ]
# /Border [ 0 0 1 ]
# >> endobj
#
# 10 0 obj <<
# /Type /EmbeddedFile
# /Length ...
# >> stream
# ...
# endstream endobj
$self->{Contents} = PDFStr($file);
# Name will be ignored if there is an AP.
$self->{Name} = PDFName($icon) unless ref($icon);
# $self->{F} = PDFNum(0b0);
$self->{C} = PDFArray( map { PDFNum($_) } 1, 1, 0 );
# The File Specification.
$self->{FS} = PDFDict();
$self->{FS}->{F} = PDFStr($file);
$self->{FS}->{Type} = PDFName('F');
$self->{FS}->{EF} = PDFDict($file);
$self->{FS}->{EF}->{F} = PDFDict($file);
$self->{' apipdf'}->new_obj($self->{FS}->{EF}->{F});
$self->{FS}->{EF}->{F}->{Type} = PDFName('EmbeddedFile');
$self->{FS}->{EF}->{F}->{' streamfile'} = $file;
# Set the annotation rectangle and border.
$self->rect(@r) if @r;
$self->border(@b) if @b;
# Set the appearance.
$self->appearance($icon, %opts) if $icon;
return($self);
}
sub appearance {
my ( $self, $icon, %opts ) = @_;
return unless $self->{Subtype}->val eq 'FileAttachment';
my @r = @{ $opts{-rect}} if defined $opts{-rect};
die "insufficient -rect parameters to annotation->appearance( ) "
unless(scalar @r == 4);
# Handle custom icon type 'None'.
if ( $icon eq 'None' ) {
# It is not clear what viewers will do, so provide an
# appearance dict with no graphics content.
# 9 0 obj <<
# ...
# /AP << /D 11 0 R /N 11 0 R /R 11 0 R >>
# ...
# >>
# 11 0 obj <<
# /BBox [ 0 0 100 100 ]
# /FormType 1
# /Length 6
# /Matrix [ 1 0 0 1 0 0 ]
# /Resources <<
# /ProcSet [ /PDF ]
# >>
# >> stream
# 0 0 m
# endstream endobj
$self->{AP} = PDFDict();
my $d = PDFDict();
$self->{' apipdf'}->new_obj($d);
$d->{FormType} = PDFNum(1);
$d->{Matrix} = PDFArray( map { PDFNum($_) } 1, 0, 0, 1, 0, 0 );
$d->{Resources} = PDFDict();
$d->{Resources}->{ProcSet} = PDFArray( map { PDFName($_) } qw(PDF));
$d->{BBox} = PDFArray( map { PDFNum($_) } 0, 0, $r[2]-$r[0], $r[3]-$r[1] );
$d->{' stream'} = "0 0 m";
$self->{AP}->{N} = $d; # normal appearance
# Should default to N, but be sure.
$self->{AP}->{R} = $d; # Rollover
$self->{AP}->{D} = $d; # Down
}
# Handle custom icon.
elsif ( ref $icon ) {
# Provide an appearance dict with the image.
# 9 0 obj <<
# ...
# /AP << /D 11 0 R /N 11 0 R /R 11 0 R >>
# ...
# >>
# 11 0 obj <<
# /BBox [ 0 0 1 1 ]
# /FormType 1
# /Length 13
# /Matrix [ 1 0 0 1 0 0 ]
# /Resources <<
# /ProcSet [ /PDF /Text /ImageB /ImageC /ImageI ]
# /XObject << /PxCBA 7 0 R >>
# >>
# >> stream
# q /PxCBA Do Q
# endstream endobj
$self->{AP} = PDFDict();
my $d = PDFDict();
$self->{' apipdf'}->new_obj($d);
$d->{FormType} = PDFNum(1);
$d->{Matrix} = PDFArray( map { PDFNum($_) } 1, 0, 0, 1, 0, 0 );
$d->{Resources} = PDFDict();
$d->{Resources}->{ProcSet} = PDFArray( map { PDFName($_) } qw(PDF Text ImageB ImageC ImageI));
$d->{Resources}->{XObject} = PDFDict();
my $im = $icon->{Name}->val;
$d->{Resources}->{XObject}->{$im} = $icon;
# Note that the image is scaled to one unit in user space.
$d->{BBox} = PDFArray( map { PDFNum($_) } 0, 0, 1, 1 );
$d->{' stream'} = "q /$im Do Q";
$self->{AP}->{N} = $d; # normal appearance
# Should default to N, but be sure.
$self->{AP}->{R} = $d; # Rollover
$self->{AP}->{D} = $d; # Down
}
return $self;
}
