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

package PDF::API2::Resource::Font::CoreFont;

use base 'PDF::API2::Resource::Font';

use strict;
use warnings;

our $VERSION = '2.044'; # VERSION

use File::Basename;

use PDF::API2::Util;
use PDF::API2::Basic::PDF::Utils;

# Windows fonts with Type1 equivalents
my $alias = {
    'arial'           => 'helvetica',
    'arialitalic'     => 'helveticaoblique',
    'arialbold'       => 'helveticabold',
    'arialbolditalic' => 'helveticaboldoblique',

    'times'                   => 'timesroman',
    'timesnewromanbolditalic' => 'timesbolditalic',
    'timesnewromanbold'       => 'timesbold',
    'timesnewromanitalic'     => 'timesitalic',
    'timesnewroman'           => 'timesroman',

    'couriernewbolditalic' => 'courierboldoblique',
    'couriernewbold'       => 'courierbold',
    'couriernewitalic'     => 'courieroblique',
    'couriernew'           => 'courier',
};

=head1 NAME

PDF::API2::Resource::Font::CoreFont - Module for using the 14 standard PDF fonts.

=head1 SYNOPSIS

    my $pdf = PDF::API2->new();
    my $font = $pdf->font('Times-Roman');

    my $page = $pdf->page();
    my $text = $page->text();
    $text->font($font, 20);
    $text->translate(200, 700);
    $text->text('Hello world!');

    $pdf->save('/path/to/new.pdf');

=head1 STANDARD FONTS

The following fourteen fonts are available in all PDF readers that conform to
the PDF specification:

=over

=item * Courier

=item * Courier-Bold

=item * Courier-BoldOblique

=item * Courier-Oblique

=item * Helvetica

=item * Helvetica-Bold

=item * Helvetica-BoldOblique

=item * Helvetica-Oblique

=item * Symbol

=item * Times-Bold

=item * Times-BoldItalic

=item * Times-Italic

=item * Times-Roman

=item * ZapfDingbats

=back

These fonts (except Symbol and ZapfDingbats) include glyphs for ASCII and
certain Latin characters only.  If other characters are needed, you will need to
embed a font file.

=cut

sub _look_for_font {
    my $name = shift();
    eval "require PDF::API2::Resource::Font::CoreFont::$name";
    if ($@) {
        die "requested font '$name' not installed";
    }

    my $class = "PDF::API2::Resource::Font::CoreFont::$name";
    my $font = _deep_copy($class->data());
    $font->{'uni'} ||= [];
    foreach my $n (0..255) {
        unless (defined $font->{'uni'}->[$n]) {
            $font->{'uni'}->[$n] = uniByName($font->{'char'}->[$n]);
        }
    }
    return %$font;
}

# Deep copy something, thanks to Randal L. Schwartz
# Changed to deal with code refs, in which case it doesn't try to deep copy
sub _deep_copy {
    my $this = shift();
    no warnings 'recursion';
    unless (ref($this)) {
        return $this;
    }
    elsif (ref($this) eq 'ARRAY') {
        return [ map { _deep_copy($_) } @$this];
    }
    elsif (ref($this) eq 'HASH') {
        return +{ map { $_ => _deep_copy($this->{$_}) } keys %$this };
    }
    elsif (ref $this eq "CODE") {
        # Can't deep copy code refs
        return $this;
    }
    else {
        die 'Unable to copy a ' . ref($this);
    }
}

sub new {
    my ($class, $pdf, $name, %options) = @_;
    my $is_standard = is_standard($name);

    if (-f $name) {
        eval "require '$name'";
        $name = basename($name, '.pm');
    }

    my $lookname = lc($name);
    $lookname =~ s/[^a-z0-9]+//gi;
    $lookname = $alias->{$lookname} if $alias->{$lookname};

    my $data;
    unless (defined $options{'-metrics'}) {
        $data = { _look_for_font($lookname) };
    }
    else {
        $data = { %{$options{'-metrics'}} };
    }

    die "Undefined font '$name($lookname)'" unless $data->{'fontname'};

    $class = ref($class) if ref($class);
    my $self = $class->SUPER::new($pdf, $data->{'apiname'} . pdfkey() . '~' . time());
    $pdf->new_obj($self) unless $self->is_obj($pdf);
    $self->{' data'} = $data;
    $self->{'-dokern'} = 1 if $options{'-dokern'};

    $self->{'Subtype'} = PDFName($self->data->{'type'});
    $self->{'BaseFont'} = PDFName($self->fontname());
    if ($options{'-pdfname'}) {
        $self->name($options{'-pdfname'});
    }

    unless ($self->data->{'iscore'}) {
        $self->{'FontDescriptor'} = $self->descrByData();
    }

    $self->encodeByData($options{'-encode'});

    # The standard non-symbolic fonts use unmodified WinAnsiEncoding.
    if ($is_standard and not $self->issymbol() and not $options{'-encode'}) {
        $self->{'Encoding'} = PDFName('WinAnsiEncoding');
        delete $self->{'FirstChar'};
        delete $self->{'LastChar'};
        delete $self->{'Widths'};
    }

    return $self;
}

=head1 METHODS

=head2 is_standard

    my $boolean = $class->is_standard($name);

Returns true if C<$name> is an exact, case-sensitive match for one of the
standard font names shown above.

=cut

sub is_standard {
    my $name = pop();

    return 1 if $name eq 'Courier';
    return 1 if $name eq 'Courier-Bold';
    return 1 if $name eq 'Courier-BoldOblique';
    return 1 if $name eq 'Courier-Oblique';
    return 1 if $name eq 'Helvetica';
    return 1 if $name eq 'Helvetica-Bold';
    return 1 if $name eq 'Helvetica-BoldOblique';
    return 1 if $name eq 'Helvetica-Oblique';
    return 1 if $name eq 'Symbol';
    return 1 if $name eq 'Times-Bold';
    return 1 if $name eq 'Times-BoldItalic';
    return 1 if $name eq 'Times-Italic';
    return 1 if $name eq 'Times-Roman';
    return 1 if $name eq 'ZapfDingbats';
    return;
}

1;