#!/usr/bin/perl

use strict;
use warnings;

use lib 'ext/Font-TTF/lib';
use Font::TTF::Font;

use Getopt::Long;

main();

sub help {
    print <<EOF;
Obfuscates fonts by deleting data that is not necessary for their use in web
browsers. They should still work via \@font-face, but are a bit harder to
install and use in other applications.
The generated font will be invalid, so there are no guarantees of correct
operation - be careful to test it with all current and future browsers that
you want it to work in.

Usage:
  $0 [options] [inputfile.ttf] [outputfile.ttf]

Options:
  --verbose, -v         print various details about the font
  At least one of the following is required:
  --all                 activate all of the options below
  --names               strip font name strings
  --post                strip PostScript glyph names
EOF
    exit 1;
}

sub set_name {
    my ($font, $id, $val, $verbose) = @_;
    my $str = $font->{name}{strings}[$id];
    for my $plat (0..$#$str) {
        next unless $str->[$plat];
        for my $enc (0..$#{$str->[$plat]}) {
            next unless $str->[$plat][$enc];
            for my $lang (keys %{$str->[$plat][$enc]}) {
                next unless exists $str->[$plat][$enc]{$lang};
                if ($verbose) {
                    print "Setting string $_ (plat $plat, enc $enc) to \"$val\"\n";
                }
                $str->[$plat][$enc]{$lang} = $val;
            }
        }
    }
}

sub strip_names {
    my ($font, $verbose) = @_;

    print "Stripping names\n" if $verbose;

    $font->{name}->read;

    for (16, 17, 18) {
        if ($verbose and $font->{name}{strings}[$_]) {
            print "Deleting string $_\n";
        }
        $font->{name}{strings}[$_] = undef;
    }

    for (1, 3, 5) {
        set_name($font, $_, '', $verbose);
    }

    for (4, 6) {
        set_name($font, $_, '-', $verbose);
    }
}

sub strip_post {
    my ($font, $verbose) = @_;

    print "Stripping post table\n" if $verbose;

    # Replace it with the minimum necessary to work in browsers
    # (particularly Opera is a bit fussy)
    my $data = pack NNnnNNNNN => 0x10000, 0,  0, 0,  0, 0, 0, 0, 0;
    $font->{post} = new Font::TTF::Table(dat => $data);
}

sub main {
    my $verbose = 0;
    my $all;
    my $names;
    my $post;

    my $result = GetOptions(
        'verbose' => \$verbose,
        'all' => \$all,
        'names' => \$names,
        'post' => \$post,
    ) or help();

    @ARGV == 2 or help();

    if (not ($all or $names or $post)) { help(); }

    my ($input_file, $output_file) = @ARGV;

    my $font = Font::TTF::Font->open($input_file) or die "Error opening $input_file: $!";

    strip_names($font, $verbose) if $all or $names;
    strip_post($font, $verbose) if $all or $post;

    $font->out($output_file);

    $font->release;
}