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   1138 use base 'PDF::API2::Resource::Font';
  9         24  
  9         4441  
4              
5 9     9   65 use strict;
  9         21  
  9         197  
6 9     9   47 use warnings;
  9         20  
  9         382  
7              
8             our $VERSION = '2.044'; # VERSION
9              
10 9     9   69 use File::Basename;
  9         21  
  9         656  
11              
12 9     9   56 use PDF::API2::Util;
  9         28  
  9         1004  
13 9     9   72 use PDF::API2::Basic::PDF::Utils;
  9         26  
  9         2847  
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   117 my $name = shift();
96 53         5064 eval "require PDF::API2::Resource::Font::CoreFont::$name";
97 53 50       327 if ($@) {
98 0         0 die "requested font '$name' not installed";
99             }
100              
101 53         208 my $class = "PDF::API2::Resource::Font::CoreFont::$name";
102 53         406 my $font = _deep_copy($class->data());
103 53   100     2062 $font->{'uni'} ||= [];
104 53         212 foreach my $n (0..255) {
105 13568 100       24538 unless (defined $font->{'uni'}->[$n]) {
106 13312         23903 $font->{'uni'}->[$n] = uniByName($font->{'char'}->[$n]);
107             }
108             }
109 53         1006 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   41982 my $this = shift();
116 9     9   81 no warnings 'recursion';
  9         20  
  9         6418  
117 31743 0       46933 unless (ref($this)) {
    50          
    100          
    100          
118 31345         64645 return $this;
119             }
120 0         0 elsif (ref($this) eq 'ARRAY') {
121 291         562 return [ map { _deep_copy($_) } @$this];
  15140         21439  
122             }
123 0         0 elsif (ref($this) eq 'HASH') {
124 107         2562 return +{ map { $_ => _deep_copy($this->{$_}) } keys %$this };
  16550         26112  
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 173 my ($class, $pdf, $name, %options) = @_;
137 53         184 my $is_standard = is_standard($name);
138              
139 53 50       1668 if (-f $name) {
140 0         0 eval "require '$name'";
141 0         0 $name = basename($name, '.pm');
142             }
143              
144 53         232 my $lookname = lc($name);
145 53         206 $lookname =~ s/[^a-z0-9]+//gi;
146 53 50       172 $lookname = $alias->{$lookname} if $alias->{$lookname};
147              
148 53         130 my $data;
149 53 50       217 unless (defined $options{'-metrics'}) {
150 53         184 $data = { _look_for_font($lookname) };
151             }
152             else {
153 0         0 $data = { %{$options{'-metrics'}} };
  0         0  
154             }
155              
156 53 50       285 die "Undefined font '$name($lookname)'" unless $data->{'fontname'};
157              
158 53 50       179 $class = ref($class) if ref($class);
159 53         269 my $self = $class->SUPER::new($pdf, $data->{'apiname'} . pdfkey() . '~' . time());
160 53 50       156 $pdf->new_obj($self) unless $self->is_obj($pdf);
161 53         150 $self->{' data'} = $data;
162 53 50       186 $self->{'-dokern'} = 1 if $options{'-dokern'};
163              
164 53         212 $self->{'Subtype'} = PDFName($self->data->{'type'});
165 53         233 $self->{'BaseFont'} = PDFName($self->fontname());
166 53 50       212 if ($options{'-pdfname'}) {
167 0         0 $self->name($options{'-pdfname'});
168             }
169              
170 53 100       154 unless ($self->data->{'iscore'}) {
171 15         50 $self->{'FontDescriptor'} = $self->descrByData();
172             }
173              
174 53         359 $self->encodeByData($options{'-encode'});
175              
176             # The standard non-symbolic fonts use unmodified WinAnsiEncoding.
177 53 100 100     360 if ($is_standard and not $self->issymbol() and not $options{'-encode'}) {
      100        
178 21         64 $self->{'Encoding'} = PDFName('WinAnsiEncoding');
179 21         74 delete $self->{'FirstChar'};
180 21         48 delete $self->{'LastChar'};
181 21         891 delete $self->{'Widths'};
182             }
183              
184 53         335 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 127 my $name = pop();
200              
201 54 50       198 return 1 if $name eq 'Courier';
202 54 50       173 return 1 if $name eq 'Courier-Bold';
203 54 50       145 return 1 if $name eq 'Courier-BoldOblique';
204 54 50       145 return 1 if $name eq 'Courier-Oblique';
205 54 100       142 return 1 if $name eq 'Helvetica';
206 32 50       78 return 1 if $name eq 'Helvetica-Bold';
207 32 50       75 return 1 if $name eq 'Helvetica-BoldOblique';
208 32 50       79 return 1 if $name eq 'Helvetica-Oblique';
209 32 50       83 return 1 if $name eq 'Symbol';
210 32 100       70 return 1 if $name eq 'Times-Bold';
211 31 50       73 return 1 if $name eq 'Times-BoldItalic';
212 31 50       86 return 1 if $name eq 'Times-Italic';
213 31 100       86 return 1 if $name eq 'Times-Roman';
214 30 100       62 return 1 if $name eq 'ZapfDingbats';
215 29         99 return;
216             }
217              
218             1;