view release on metacpan or  search on metacpan

lib/ChordPro/lib/SVGPDF/FontManager.pm  view on Meta::CPAN

    my ( $font, $size, $src ) = $self->find_font($style);
    $xo->font( $font, $size );
}

method find_font ( $style ) {

    my $stl    = lc( $style->{'font-style'}  // "normal" );
    my $weight = lc( $style->{'font-weight'} // "normal" );
    ####TODO: normalize styles and weights.

    # Process the font-families, if any.
    for ( ffsplit( $style->{'font-family'} // [] ) ) {
	my $family = lc($_);

	# Check against @font-faces, if any.
	for ( @{ $style->{'@font-face'}//[] } ) {
	    my $fam = $_->{'font-family'};
	    next unless $fam && lc($fam) eq $family;
	    next unless $_->{src};
	    next if $_->{'font-style'} && $style->{'font-style'}
	      && $_->{'font-style'} ne $style->{'font-style'};
	    next if $_->{'font-weight'} && $style->{'font-weight'}
	      && $_->{'font-weight'} ne $style->{'font-weight'};

	    $fam = lc($fam);
	    my $key = join( "|", $fam, $stl, $weight );
	    # Font in cache?
	    if ( my $f = $fc->{$key} ) {
		return ( $f->{font},
			 $style->{'font-size'} || 12,
			 $f->{src} );
	    }

	    # Fetch font from source.
	    my $src = $_->{src};
	    ####TODO: Multiple sources
	    if ( $src =~ /^\s*url\s*\((["'])((?:data|https?|file):.*?)\1\s*\)/is ) {
		use File::LoadLines 1.044;
		my $opts = {};
		my $data = File::LoadLines::loadblob( $2, $opts );

		# To load font data from net and data urls.
		use File::Temp qw( tempfile tempdir );
		use MIME::Base64 qw( decode_base64 );
		$td //= tempdir( CLEANUP => 1 );

		my $sfx;	# suffix for font file name
		if ( $src =~ /\bformat\((["'])(.*?)\1\)/ ) {
		    $sfx =
		      lc($2) eq "truetype" ? ".ttf" :
		      lc($2) eq "opentype" ? ".otf" :
		      '';
		}
		elsif ( $opts->{_filesource} =~ /\.(\w+)$/ ) {
		    $sfx = $2;
		}
		# No (or unknown) format, skip.
		next unless $sfx;

		my ($fh,$fn) = tempfile( "${td}SVGXXXX", SUFFIX => $sfx );
		binmode( $fh => ':raw' );
		print $fh $data;
		close($fh);
		my $font = eval { $svg->pdf->font($fn) };
		croak($@) if $@;
		my $f = $fc->{$key} =
		  { font => $font,
		    src => $opts->{_filesource} };
		#warn("SRC: ", $opts->{_filesource}, "\n");
		return ( $f->{font},
			 $style->{'font-size'} || 12,
			 $f->{src} );
	    }
	    # Temp.
	    elsif ( $src =~ /^\s*url\s*\((["'])data:application\/octet-stream;base64,(.*?)\1\s*\)/is ) {

		my $data = $2;

		# To load font data from net and data urls.
		use File::Temp qw( tempfile tempdir );
		use MIME::Base64 qw( decode_base64 );
		$td //= tempdir( CLEANUP => 1 );

		my $sfx;	# suffix for font file name
		if ( $src =~ /\bformat\((["'])(.*?)\1\)/ ) {
		    $sfx =
		      lc($2) eq "truetype" ? ".ttf" :
		      lc($2) eq "opentype" ? ".otf" :
		      '';
		}
		# No (or unknown) format, skip.
		next unless $sfx;

		my ($fh,$fn) = tempfile( "${td}SVGXXXX", SUFFIX => $sfx );
		binmode( $fh => ':raw' );
		print $fh decode_base64($data);
		close($fh);
		my $font = eval { $svg->pdf->font($fn) };
		croak($@) if $@;
		my $f = $fc->{$key} =
		  { font => $font,
		    src => 'data' };
		return ( $f->{font},
			 $style->{'font-size'} || 12,
			 $f->{src} );
	    }
	    elsif ( $src =~ /^\s*url\s*\((["'])(.*?\.[ot]tf)\1\s*\)/is ) {
		my $fn = $2;
		my $font = eval { $svg->pdf->font($fn) };
		croak($@) if $@;
		my $f = $fc->{$key} =
		  { font => $font,
		    src => $fn };
		return ( $f->{font},
			 $style->{'font-size'} || 12,
			 $f->{src} );
	    }
	    else {
		croak("\@font-face: Unhandled src \"", substr($src,0,50), "...\"");
	    }
	}
    }

    my $key = join( "|", $style->{'font-family'}, $stl, $weight );
    # Font in cache?
    if ( my $f = $fc->{$key} ) {
	return ( $f->{font},
		 $style->{'font-size'} || 12,
		 $f->{src} );
    }

    if ( my $cb = $svg->fc ) {
	my $font;
	unless ( ref($cb) eq 'ARRAY' ) {
	    $cb = [ $cb ];
	}
	# Run callbacks.
	my %args = ( pdf => $svg->pdf, style => $style );
	for ( @$cb ) {
	    eval { $font = $_->( $svg, %args ) };
	    croak($@) if $@;
	    last if $font;
	}

	if ( $font ) {
	    my $src = "Callback($key)";
	    $fc->{$key} = { font => $font, src => $src };
	    return ( $font,
		     $style->{'font-size'} || 12,
		     $src );
	}
    }

    # No @font-face, no (or failed) callbacks, we're on our own.