#! /usr/bin/perl
use Font::TTF::Font;
use Font::TTF::PSNames qw(parse lookup);

unless (defined $ARGV[1])
{
    die <<'EOT';
    PSFIX infile outfile
Updates Postscript table to account for Postscript Unicode conventions
EOT
}

$f = Font::TTF::Font->open($ARGV[0]) || die "Unable to open font file $ARGV[0]";
exit(1) if (!defined $f->{'post'});
$p = $f->{'post'}->read;
$num = $f->{'maxp'}{'numGlyphs'};
@rmap = $f->{'cmap'}->read->reverse();
$nmap = {};

for ($i = 1; $i < $num; $i++)
{
    if (defined $rmap[$i])
    {
        $nmap{$p->{'VAL'}[$i]} = lookup($rmap[$i]);
        $nmap{$p->{'VAL'}[$i]} =~ s/^uni/u/o;
    }
}

for ($i = 1; $i < $num; $i++)
{
    my (@parts) = split(/([_\/.])/, $p->{'VAL'}[$i]);
    for ($j = 0; $j < @parts; $j += 2)
    {
        $parts[$j] = $nmap{$parts[$j]} || $parts{$j} if (!$j || $parts[$j - 1] =~ m/[_\/]/o);
    }
    $p->{'VAL'}[$i] = join('', @parts);
}

$f->out($ARGV[1]);

__END__

=head1 TITLE

psfix - create Adobe Glyph List conformant names for glyphs in a font

=head1 SYNOPSIS

    PSFIX infile outfile
Updates Postscript table to account for Postscript Unicode conventions

=head1 DESCRIPTION

Creates Adobe Glyph List conformant names for each of the glyphs in a font.

=head1 TODO

Need to merge code with C<Font::TTF::PSNames>. This code is somewhat out
of date.

=cut