#! /usr/bin/perl
use strict;
use Font::TTF::Font;
use Font::TTF::PSNames qw(parse lookup);
use Getopt::Std;
use Pod::Usage;

our ($CHAIN_CALL, $f, %opts);

unless ($CHAIN_CALL)
{
    getopts('ahsv', \%opts);

    unless (defined $ARGV[1] || defined $opts{'h'})
    {
        pod2usage(1);
        exit;
    }

    if ($opts{'h'})
    {
        pod2usage( -verbose => 2, -noperldoc => 1);
        exit;
    }

    $f = Font::TTF::Font->open($ARGV[0]) || die "Unable to open font file $ARGV[0]";
}


exit(1) if (!defined $f->{'post'});
my $p = $f->{'post'}->read;
$p->dirty;

if ($opts{'s'})
{
    # Strip post table
    $p->{'VAL'} = [];
    $p->{'STRINGS'} = {};
}
else
{
    my ($num, @rmap, %nmap, $i);
    $num = $f->{'maxp'}{'numGlyphs'};
    @rmap = $f->{'cmap'}->read->reverse();
    
    for ($i = 1; $i < $num; $i++)
    {
        if (defined $rmap[$i])
        {
            my ($current, $ext) = ($p->{'VAL'}[$i] =~ /^([^.]*)(\..*)?$/o);
            next unless $current;
            $nmap{$current} = lookup($rmap[$i], $opts{'a'});
            $nmap{$current} =~ s/^uni/u/o;
        }
    }
    
    for ($i = 1; $i < $num; $i++)
    {
        my (@parts) = split(/([_\/.])/, $p->{'VAL'}[$i]);
        for (my $j = 0; $j < @parts; $j += 2)
        {
            $parts[$j] = $nmap{$parts[$j]} || $parts[$j] if (!$j || $parts[$j - 1] =~ m/[_\/]/o);
            $parts[$j] =~ s/[][()<>{}%]|\s//og; # Make sure nothing invalid remains (even in extension)
        }
        my $new = join('', @parts);
        if ($p->{'VAL'}[$i] ne $new)
        {
            print STDOUT "$p->{'VAL'}[$i] -> $new\n" if $opts{'v'};
            $p->{'VAL'}[$i] = $new;
        }
    }
}

unless ($CHAIN_CALL)
{
    $f->out($ARGV[1]);
}

__END__

=head1 NAME

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

=head1 SYNOPSIS

    psfix [-a] [-s] [-v] infile outfile
    psfix -h

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 OPTIONS

  -a  Prefer afii names over uXXXX names
  -s  strip out ps names (making converting to version 3 post table)
  -v  verbose
  -h  help

=head1 AUTHOR

Martin Hosken L<http://scripts.sil.org/FontUtils>.
(see CONTRIBUTORS for other authors).

=head1 LICENSING

Copyright (c) 1998-2016, SIL International (http://www.sil.org)

This script is released under the terms of the Artistic License 2.0.
For details, see the full text of the license in the file LICENSE.

=cut