File Coverage

blib/lib/PDF/API2/Resource/CIDFont.pm
Criterion Covered Total %
statement 37 154 24.0
branch 2 66 3.0
condition 1 70 1.4
subroutine 8 30 26.6
pod 8 23 34.7
total 56 343 16.3


line stmt bran cond sub pod time code
1             package PDF::API2::Resource::CIDFont;
2              
3 2     2   998 use base 'PDF::API2::Resource::BaseFont';
  2         10  
  2         648  
4              
5 2     2   23 use strict;
  2         5  
  2         42  
6 2     2   11 use warnings;
  2         5  
  2         108  
7              
8             our $VERSION = '2.044'; # VERSION
9              
10 2     2   15 use Encode qw(:all);
  2         3  
  2         577  
11              
12 2     2   16 use PDF::API2::Basic::PDF::Utils;
  2         4  
  2         174  
13 2     2   14 use PDF::API2::Util;
  2         8  
  2         4807  
14              
15             =head1 NAME
16              
17             PDF::API2::Resource::CIDFont - Base class for CID fonts
18              
19             =head1 METHODS
20              
21             =over
22              
23             =item $font = PDF::API2::Resource::CIDFont->new $pdf, $name
24              
25             Returns a cid-font object. base class form all CID based fonts.
26              
27             =cut
28              
29             sub new {
30 1     1 1 5 my ($class, $pdf, $name, %opts) = @_;
31 1 50       6 $class = ref($class) if ref($class);
32              
33 1         12 my $self = $class->SUPER::new($pdf, $name);
34              
35 1 50 33     7 $pdf->new_obj($self) if defined $pdf and not $self->is_obj($pdf);
36              
37 1         5 $self->{'Type'} = PDFName('Font');
38 1         4 $self->{'Subtype'} = PDFName('Type0');
39 1         4 $self->{'Encoding'} = PDFName('Identity-H');
40              
41 1         4 my $de = PDFDict();
42 1         4 $pdf->new_obj($de);
43 1         6 $self->{'DescendantFonts'} = PDFArray($de);
44              
45 1         4 $de->{'Type'} = PDFName('Font');
46 1         4 $de->{'CIDSystemInfo'} = PDFDict();
47 1         8 $de->{'CIDSystemInfo'}->{'Registry'} = PDFStr('Adobe');
48 1         3 $de->{'CIDSystemInfo'}->{'Ordering'} = PDFStr('Identity');
49 1         3 $de->{'CIDSystemInfo'}->{'Supplement'} = PDFNum(0);
50 1         3 $de->{'CIDToGIDMap'} = PDFName('Identity');
51              
52 1         3 $self->{' de'} = $de;
53              
54 1         5 return $self;
55             }
56              
57 0     0 0 0 sub glyphByCId { return $_[0]->data->{'g2n'}->[$_[1]] }
58              
59 0     0 0 0 sub uniByCId { return $_[0]->data->{'g2u'}->[$_[1]] }
60              
61 53     53 0 92 sub cidByUni { return $_[0]->data->{'u2g'}->{$_[1]} }
62              
63 0     0 0   sub cidByEnc { return $_[0]->data->{'e2g'}->[$_[1]] }
64              
65             sub wxByCId {
66 0     0 0   my ($self, $g) = @_;
67              
68 0           my $widths = $self->data->{'wx'};
69 0 0         if (ref($widths) eq 'ARRAY') {
    0          
70 0 0         return int($widths->[$g]) if defined $widths->[$g];
71             }
72             elsif (ref($widths) eq 'HASH') {
73 0 0         return int($widths->{$g}) if defined $widths->{$g};
74             }
75 0           return $self->missingwidth();
76             }
77              
78 0     0 1   sub wxByUni { return $_[0]->wxByCId($_[0]->data->{'u2g'}->{$_[1]}) }
79 0     0 1   sub wxByEnc { return $_[0]->wxByCId($_[0]->data->{'e2g'}->[$_[1]]) }
80              
81             sub width {
82 0     0 1   my ($self, $text) = @_;
83 0           return $self->width_cid($self->cidsByStr($text));
84             }
85              
86             sub width_cid {
87 0     0 0   my ($self, $text) = @_;
88 0           my $width = 0;
89 0           my $lastglyph = 0;
90 0           foreach my $n (unpack('n*', $text)) {
91 0           $width += $self->wxByCId($n);
92 0 0 0       if ($self->{'-dokern'} and $self->haveKernPairs()) {
93 0 0         if ($self->kernPairCid($lastglyph, $n)) {
94 0           $width -= $self->kernPairCid($lastglyph, $n);
95             }
96             }
97 0           $lastglyph = $n;
98             }
99 0           $width /= 1000;
100 0           return $width;
101             }
102              
103             =item $cidstring = $font->cidsByStr $string
104              
105             Returns the cid-string from string based on the fonts encoding map.
106              
107             =cut
108              
109             sub _cidsByStr {
110 0     0     my ($self, $s) = @_;
111 0           $s = pack('n*', map { $self->cidByEnc($_) } unpack('C*', $s));
  0            
112 0           return $s;
113             }
114              
115             sub cidsByStr {
116 0     0 1   my ($self, $text) = @_;
117 0 0 0       if (utf8::is_utf8($text)
    0 0        
    0 0        
    0 0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
118             and defined $self->data->{'decode'}
119             and $self->data->{'decode'} ne 'ident')
120             {
121 0           $text = encode($self->data->{'decode'}, $text);
122             }
123             elsif (utf8::is_utf8($text)
124             and defined $self->data->{'decode'}
125             and $self->data->{'decode'} eq 'ident')
126             {
127 0           $text = $self->cidsByUtf($text);
128             }
129             elsif (not utf8::is_utf8($text)
130             and defined $self->data->{'encode'}
131             and defined $self->data->{'decode'}
132             and $self->data->{'decode'} eq 'ident')
133             {
134 0           $text = $self->cidsByUtf(decode($self->data->{'encode'}, $text));
135             }
136             elsif (not utf8::is_utf8($text)
137             and $self->can('issymbol')
138             and $self->issymbol()
139             and defined $self->data->{'decode'}
140             and $self->data->{'decode'} eq 'ident')
141             {
142 0           $text = pack('U*', map { $_ + 0xf000 } unpack('C*', $text));
  0            
143 0           $text = $self->cidsByUtf($text);
144             }
145             else {
146 0           $text = $self->_cidsByStr($text);
147             }
148 0           return $text;
149             }
150              
151             =item $cidstring = $font->cidsByUtf $utf8string
152              
153             Returns the cid-encoded string from utf8-string.
154              
155             =cut
156              
157             sub cidsByUtf {
158 0     0 1   my ($self, $s) = @_;
159             $s = pack('n*',
160 0   0       map { $self->cidByUni($_) // 0 }
161             map {
162 0 0 0       ($_ and $_ > 0x7f and $_ < 0xa0) ? uniByName(nameByUni($_)) : $_
  0            
163             }
164             unpack('U*', $s));
165 0           utf8::downgrade($s);
166 0           return $s;
167             }
168              
169             sub textByStr {
170 0     0 1   my ($self, $text) = @_;
171 0           return $self->text_cid($self->cidsByStr($text));
172             }
173              
174             sub textByStrKern {
175 0     0 0   my ($self, $text, $size, $indent) = @_;
176 0           return $self->text_cid_kern($self->cidsByStr($text), $size, $indent);
177             }
178              
179             sub text {
180 0     0 0   my ($self, $text, $size, $indent) = @_;
181 0           my $newtext = $self->textByStr($text);
182 0 0 0       if (defined $size and $self->{'-dokern'}) {
    0          
183 0           $newtext = $self->textByStrKern($text, $size, $indent);
184 0           return $newtext;
185             }
186             elsif (defined $size) {
187 0 0 0       if (defined($indent) and $indent != 0) {
188 0           return "[ $indent $newtext ] TJ";
189             }
190             else {
191 0           return "$newtext Tj";
192             }
193             }
194             else {
195 0           return $newtext;
196             }
197             }
198              
199             sub text_cid {
200 0     0 0   my ($self, $text, $size) = @_;
201 0 0         if ($self->can('fontfile')) {
202 0           foreach my $g (unpack('n*', $text)) {
203 0           $self->fontfile->subsetByCId($g);
204             }
205             }
206 0           my $newtext = unpack('H*', $text);
207 0 0         if (defined $size) {
208 0           return "<$newtext> Tj";
209             }
210             else {
211 0           return "<$newtext>";
212             }
213             }
214              
215             sub text_cid_kern {
216 0     0 0   my ($self, $text, $size, $indent) = @_;
217 0 0         if ($self->can('fontfile')) {
218 0           foreach my $g (unpack('n*', $text)) {
219 0           $self->fontfile->subsetByCId($g);
220             }
221             }
222 0 0 0       if (defined $size and $self->{'-dokern'} and $self->haveKernPairs()) {
    0 0        
223 0           my $newtext = ' ';
224 0           my $lastglyph = 0;
225 0           my $tBefore = 0;
226 0           foreach my $n (unpack('n*', $text)) {
227 0 0         if ($self->kernPairCid($lastglyph, $n)) {
228 0 0         $newtext .= '> ' if $tBefore;
229 0           $newtext .= sprintf('%i ', $self->kernPairCid($lastglyph, $n));
230 0           $tBefore = 0;
231             }
232 0           $lastglyph = $n;
233 0           my $t = sprintf('%04X', $n);
234 0 0         $newtext .= '<' unless $tBefore;
235 0           $newtext .= $t;
236 0           $tBefore = 1;
237             }
238 0 0         $newtext .= '> ' if $tBefore;
239 0 0 0       if (defined $indent and $indent != 0) {
240 0           return "[ $indent $newtext ] TJ";
241             }
242             else {
243 0           return "[ $newtext ] TJ";
244             }
245             }
246             elsif (defined $size) {
247 0           my $newtext = unpack('H*', $text);
248 0 0 0       if (defined($indent) and $indent != 0) {
249 0           return "[ $indent <$newtext> ] TJ";
250             }
251             else {
252 0           return "<$newtext> Tj";
253             }
254             }
255             else {
256 0           my $newtext = unpack('H*', $text);
257 0           return "<$newtext>";
258             }
259             }
260              
261             sub kernPairCid {
262 0     0 0   return 0;
263             }
264              
265             sub haveKernPairs {
266 0     0 0   return;
267             }
268              
269             sub encodeByName {
270 0     0 0   my ($self, $enc) = @_;
271 0 0         return if $self->issymbol();
272              
273 0 0         if (defined $enc) {
274             $self->data->{'e2u'} = [
275 0 0 0       map { ($_ > 0x7f and $_ < 0xA0) ? uniByName(nameByUni($_)) : $_ }
  0            
276             unpack('U*', decode($enc, pack('C*', 0 .. 255)))
277             ];
278             }
279             $self->data->{'e2n'} = [
280 0 0 0       map { $self->data->{'g2n'}->[$self->data->{'u2g'}->{$_} || 0] || '.notdef' }
281 0           @{$self->data->{'e2u'}}
  0            
282             ];
283             $self->data->{'e2g'} = [
284 0 0         map { $self->data->{'u2g'}->{$_} || 0 }
285 0           @{$self->data->{'e2u'}}
  0            
286             ];
287              
288 0           $self->data->{'u2e'} = {};
289 0           foreach my $n (reverse 0 .. 255) {
290 0   0       $self->data->{'u2e'}->{$self->data->{'e2u'}->[$n]} //= $n;
291             }
292              
293 0           return $self;
294             }
295              
296             sub subsetByCId {
297 0     0 0   return 1;
298             }
299              
300             sub subvec {
301 0     0 0   return 1;
302             }
303              
304             sub glyphNum {
305 0     0 1   my $self = shift();
306 0 0         if (defined $self->data->{'glyphs'}) {
307 0           return $self->data->{'glyphs'};
308             }
309 0           return scalar @{$self->data->{'wx'}};
  0            
310             }
311              
312             =back
313              
314             =cut
315              
316             1;