File Coverage

blib/lib/PDF/API2/Resource/Font/CoreFont.pm
Criterion Covered Total %
statement 81 92 88.0
branch 38 60 63.3
condition 8 8 100.0
subroutine 11 11 100.0
pod 2 2 100.0
total 140 173 80.9


line stmt bran cond sub pod time code
1             package PDF::API2::Resource::Font::CoreFont;
2              
3 9     9   1602 use base 'PDF::API2::Resource::Font';
  9         18  
  9         4515  
4              
5 9     9   72 use strict;
  9         21  
  9         205  
6 9     9   55 use warnings;
  9         24  
  9         360  
7              
8             our $VERSION = '2.043'; # VERSION
9              
10 9     9   58 use File::Basename;
  9         20  
  9         678  
11              
12 9     9   55 use PDF::API2::Util;
  9         23  
  9         1086  
13 9     9   68 use PDF::API2::Basic::PDF::Utils;
  9         45  
  9         2842  
14              
15             # Windows fonts with Type1 equivalents
16             my $alias = {
17             'arial' => 'helvetica',
18             'arialitalic' => 'helveticaoblique',
19             'arialbold' => 'helveticabold',
20             'arialbolditalic' => 'helveticaboldoblique',
21              
22             'times' => 'timesroman',
23             'timesnewromanbolditalic' => 'timesbolditalic',
24             'timesnewromanbold' => 'timesbold',
25             'timesnewromanitalic' => 'timesitalic',
26             'timesnewroman' => 'timesroman',
27              
28             'couriernewbolditalic' => 'courierboldoblique',
29             'couriernewbold' => 'courierbold',
30             'couriernewitalic' => 'courieroblique',
31             'couriernew' => 'courier',
32             };
33              
34             =head1 NAME
35              
36             PDF::API2::Resource::Font::CoreFont - Module for using the 14 standard PDF fonts.
37              
38             =head1 SYNOPSIS
39              
40             my $pdf = PDF::API2->new();
41             my $font = $pdf->font('Times-Roman');
42              
43             my $page = $pdf->page();
44             my $text = $page->text();
45             $text->font($font, 20);
46             $text->translate(200, 700);
47             $text->text('Hello world!');
48              
49             $pdf->save('/path/to/new.pdf');
50              
51             =head1 STANDARD FONTS
52              
53             The following fourteen fonts are available in all PDF readers that conform to
54             the PDF specification:
55              
56             =over
57              
58             =item * Courier
59              
60             =item * Courier-Bold
61              
62             =item * Courier-BoldOblique
63              
64             =item * Courier-Oblique
65              
66             =item * Helvetica
67              
68             =item * Helvetica-Bold
69              
70             =item * Helvetica-BoldOblique
71              
72             =item * Helvetica-Oblique
73              
74             =item * Symbol
75              
76             =item * Times-Bold
77              
78             =item * Times-BoldItalic
79              
80             =item * Times-Italic
81              
82             =item * Times-Roman
83              
84             =item * ZapfDingbats
85              
86             =back
87              
88             These fonts (except Symbol and ZapfDingbats) include glyphs for ASCII and
89             certain Latin characters only. If other characters are needed, you will need to
90             embed a font file.
91              
92             =cut
93              
94             sub _look_for_font {
95 53     53   119 my $name = shift();
96 53         5378 eval "require PDF::API2::Resource::Font::CoreFont::$name";
97 53 50       340 if ($@) {
98 0         0 die "requested font '$name' not installed";
99             }
100              
101 53         168 my $class = "PDF::API2::Resource::Font::CoreFont::$name";
102 53         397 my $font = _deep_copy($class->data());
103 53   100     2144 $font->{'uni'} ||= [];
104 53         600 foreach my $n (0..255) {
105 13568 100       23846 unless (defined $font->{'uni'}->[$n]) {
106 13312         23155 $font->{'uni'}->[$n] = uniByName($font->{'char'}->[$n]);
107             }
108             }
109 53         905 return %$font;
110             }
111              
112             # Deep copy something, thanks to Randal L. Schwartz
113             # Changed to deal with code refs, in which case it doesn't try to deep copy
114             sub _deep_copy {
115 31743     31743   41272 my $this = shift();
116 9     9   97 no warnings 'recursion';
  9         22  
  9         6656  
117 31743 0       46429 unless (ref($this)) {
    50          
    100          
    100          
118 31345         63351 return $this;
119             }
120 0         0 elsif (ref($this) eq 'ARRAY') {
121 291         553 return [ map { _deep_copy($_) } @$this];
  15140         20627  
122             }
123 0         0 elsif (ref($this) eq 'HASH') {
124 107         2807 return +{ map { $_ => _deep_copy($this->{$_}) } keys %$this };
  16550         25094  
125             }
126 0         0 elsif (ref $this eq "CODE") {
127             # Can't deep copy code refs
128 0         0 return $this;
129             }
130             else {
131 0         0 die 'Unable to copy a ' . ref($this);
132             }
133             }
134              
135             sub new {
136 53     53 1 193 my ($class, $pdf, $name, %options) = @_;
137 53         177 my $is_standard = is_standard($name);
138              
139 53 50       2428 if (-f $name) {
140 0         0 eval "require '$name'";
141 0         0 $name = basename($name, '.pm');
142             }
143              
144 53         238 my $lookname = lc($name);
145 53         214 $lookname =~ s/[^a-z0-9]+//gi;
146 53 50       176 $lookname = $alias->{$lookname} if $alias->{$lookname};
147              
148 53         89 my $data;
149 53 50       171 unless (defined $options{'-metrics'}) {
150 53         212 $data = { _look_for_font($lookname) };
151             }
152             else {
153 0         0 $data = { %{$options{'-metrics'}} };
  0         0  
154             }
155              
156 53 50       293 die "Undefined font '$name($lookname)'" unless $data->{'fontname'};
157              
158 53 50       176 $class = ref($class) if ref($class);
159 53         267 my $self = $class->SUPER::new($pdf, $data->{'apiname'} . pdfkey() . '~' . time());
160 53 50       196 $pdf->new_obj($self) unless $self->is_obj($pdf);
161 53         189 $self->{' data'} = $data;
162 53 50       168 $self->{'-dokern'} = 1 if $options{'-dokern'};
163              
164 53         186 $self->{'Subtype'} = PDFName($self->data->{'type'});
165 53         242 $self->{'BaseFont'} = PDFName($self->fontname());
166 53 50       189 if ($options{'-pdfname'}) {
167 0         0 $self->name($options{'-pdfname'});
168             }
169              
170 53 100       171 unless ($self->data->{'iscore'}) {
171 15         52 $self->{'FontDescriptor'} = $self->descrByData();
172             }
173              
174 53         376 $self->encodeByData($options{'-encode'});
175              
176             # The standard non-symbolic fonts use unmodified WinAnsiEncoding.
177 53 100 100     340 if ($is_standard and not $self->issymbol() and not $options{'-encode'}) {
      100        
178 21         65 $self->{'Encoding'} = PDFName('WinAnsiEncoding');
179 21         64 delete $self->{'FirstChar'};
180 21         40 delete $self->{'LastChar'};
181 21         780 delete $self->{'Widths'};
182             }
183              
184 53         343 return $self;
185             }
186              
187             =head1 METHODS
188              
189             =head2 is_standard
190              
191             my $boolean = $class->is_standard($name);
192              
193             Returns true if C<$name> is an exact, case-sensitive match for one of the
194             standard font names shown above.
195              
196             =cut
197              
198             sub is_standard {
199 54     54 1 162 my $name = pop();
200              
201 54 50       188 return 1 if $name eq 'Courier';
202 54 50       190 return 1 if $name eq 'Courier-Bold';
203 54 50       156 return 1 if $name eq 'Courier-BoldOblique';
204 54 50       142 return 1 if $name eq 'Courier-Oblique';
205 54 100       172 return 1 if $name eq 'Helvetica';
206 32 50       88 return 1 if $name eq 'Helvetica-Bold';
207 32 50       98 return 1 if $name eq 'Helvetica-BoldOblique';
208 32 50       83 return 1 if $name eq 'Helvetica-Oblique';
209 32 50       95 return 1 if $name eq 'Symbol';
210 32 100       93 return 1 if $name eq 'Times-Bold';
211 31 50       92 return 1 if $name eq 'Times-BoldItalic';
212 31 50       72 return 1 if $name eq 'Times-Italic';
213 31 100       84 return 1 if $name eq 'Times-Roman';
214 30 100       84 return 1 if $name eq 'ZapfDingbats';
215 29         64 return;
216             }
217              
218             1;