view release on metacpan or  search on metacpan

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

		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.

    my $fn = $style->{'font-family'} // "Times-Roman";
    my $sz = $style->{'font-size'} || 12;
    my $em = $style->{'font-style'}
      && $style->{'font-style'} =~ /^(italic|oblique)$/ || '';
    my $bd = $style->{'font-weight'}
      && $style->{'font-weight'} =~ /^(bold|black)$/ || '';

    for ( ffsplit($fn) ) {
	$fn = lc($_);

	# helvetica sans sans-serif text,sans-serif
	if ( $fn =~ /^(sans|helvetica|(?:text,)?sans-serif)$/ ) {
	    $fn = $bd
	      ? $em ? "Helvetica-BoldOblique" : "Helvetica-Bold"
	      : $em ? "Helvetica-Oblique" : "Helvetica";
	}
	# courier mono monospace mono-space text
	elsif ( $fn =~ /^(text|courier|mono(?:-?space)?)$/ ) {
	    $fn = $bd
	      ? $em ? "Courier-BoldOblique" : "Courier-Bold"
	      : $em ? "Courier-Oblique" : "Courier";
	}
	# times serif text,serif
	elsif ( $fn =~ /^(serif|times|(?:text,)?serif)$/ ) {
	    $fn = $bd
	      ? $em ? "Times-BoldItalic" : "Times-Bold"
	      : $em ? "Times-Italic" : "Times-Roman";
	}
	# Any of the corefonts, case insensitive.
	elsif ( none { $fn eq lc($_) } @corefonts ) {
	    undef $fn;
	}
	last if $fn;
	# Retry other families, if any.
    }

    unless ( $fn ) {
	# Nothing found...
	$fn = $bd
	  ? $em ? "Times-BoldItalic" : "Times-Bold"
	  : $em ? "Times-Italic" : "Times-Roman";
    }

    my $font = $fc->{$fn} //= do {
	unless ( $fn =~ /\.\w+$/ ) {
	    my $t = "";
	    $t .= "italic, " if $em;
	    $t .= "bold, "   if $bd;
	    $t = " (" . substr($t, 0, length($t)-2) . ")" if $t;
	    warn("SVG: Font ", $style->{'font-family'}//"<none>",
		 "$t - falling back to built-in font $fn with limited glyphs!\n")
	}
	{ font => $svg->pdf->font($fn), src => $fn };
    };
    return ( $font->{font}, $sz, $font->{src} );
}

sub ffsplit ( $family ) {
    # I hope this traps most (ab)uses of quotes and commas.