#!/usr/opkg/bin/perl
##
##  font-fixname -- Fix "Full Font Name" in TTF font for subsequent TTF to EOT conversion
##  Copyright (c) 2010 Ralf S. Engelschall <rse@engelschall.com>
##  Licensed under MIT license.
##
##  Background: Internet Explorer when loading EOT fonts silently
##  rejects them if the "Font Family Name" is not a prefix of the
##  "Full Font Name". This can occur when automatically converting CFF
##  fonts (based on OpenType) to non-CFF fonts (based on TrueType).
##  The following procedure is partially derived from Philip Taylor's
##  "Font/Subsetter.pm" code of the Font::TTF::scripts Perl package.
##

#   language requirements
use 5.008;
use strict;
use warnings;

#   external module requirements
use Font::TTF;
use Font::TTF::Font;
use Getopt::Long;

#   parse command line options
my $verbose = 0;
my $result = GetOptions(
    "verbose" => \$verbose
) or die;

#   fetch command line arguments
my ($filename_src, $filename_dst) = @ARGV;

#   load old TTF file
my $font = Font::TTF::Font->open($filename_src)
    or die "Failed to read source font file \"$filename_src\": $!";

#   read the "name" table
$font->{name}->read();

#   iterate over all platforms
my $str1 = $font->{name}{strings}[1];
for my $plat (0..$#$str1) {
    next unless $str1->[$plat];

    #   iterate over all encodings
    for my $enc (0..$#{$str1->[$plat]}) {
        next unless $str1->[$plat][$enc];

        #   iterate over all languages
        for my $lang (keys %{$str1->[$plat][$enc]}) {
            next unless exists $str1->[$plat][$enc]{$lang};

            #   get the "Font Family Name" (name)
            my $name = $str1->[$plat][$enc]{$lang};

            #   get the "Full Font Name" (fullname)
            my $fullname = $font->{name}{strings}[4][$plat][$enc]{$lang};

            #   on prefix mismatch, substitute
            if (substr($fullname, 0, length($name)) ne $name) {
                if ($verbose)  {
                    print STDOUT "++ old \"Full Font Name\" (name/4/$plat/$enc/$lang): \"$fullname\"\n";
                    print STDOUT "   new \"Full Font Name\" (name/4/$plat/$enc/$lang): \"$name\"\n";
                }
                $font->{name}{strings}[4][$plat][$enc]{$lang} = $name;
            }
        }
    }
}

#   write new TTF file
$font->out($filename_dst)
    or die "Failed to create destination font file \"$filename_src\": $!";