good pdf, some general updates

[librarian.git] / librarian / font-optimizer / obfuscate-font.pl

diff --git a/librarian/font-optimizer/obfuscate-font.pl b/librarian/font-optimizer/obfuscate-font.pl
new file mode 100755 (executable)
index 0000000..0850426
--- /dev/null
+++ b/librarian/font-optimizer/obfuscate-font.pl
@@ -0,0 +1,114 @@
+#!/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;
+}