librarian/font-optimizer/obfuscate-font.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use lib 'ext/Font-TTF/lib';
   7 use Font::TTF::Font;
   8
   9 use Getopt::Long;
  10
  11 main();
  12
  13 sub help {
  14     print <<EOF;
  15 Obfuscates fonts by deleting data that is not necessary for their use in web
  16 browsers. They should still work via \@font-face, but are a bit harder to
  17 install and use in other applications.
  18 The generated font will be invalid, so there are no guarantees of correct
  19 operation - be careful to test it with all current and future browsers that
  20 you want it to work in.
  21
  22 Usage:
  23   $0 [options] [inputfile.ttf] [outputfile.ttf]
  24
  25 Options:
  26   --verbose, -v         print various details about the font
  27   At least one of the following is required:
  28   --all                 activate all of the options below
  29   --names               strip font name strings
  30   --post                strip PostScript glyph names
  31 EOF
  32     exit 1;
  33 }
  34
  35 sub set_name {
  36     my ($font, $id, $val, $verbose) = @_;
  37     my $str = $font->{name}{strings}[$id];
  38     for my $plat (0..$#$str) {
  39         next unless $str->[$plat];
  40         for my $enc (0..$#{$str->[$plat]}) {
  41             next unless $str->[$plat][$enc];
  42             for my $lang (keys %{$str->[$plat][$enc]}) {
  43                 next unless exists $str->[$plat][$enc]{$lang};
  44                 if ($verbose) {
  45                     print "Setting string $_ (plat $plat, enc $enc) to \"$val\"\n";
  46                 }
  47                 $str->[$plat][$enc]{$lang} = $val;
  48             }
  49         }
  50     }
  51 }
  52
  53 sub strip_names {
  54     my ($font, $verbose) = @_;
  55
  56     print "Stripping names\n" if $verbose;
  57
  58     $font->{name}->read;
  59
  60     for (16, 17, 18) {
  61         if ($verbose and $font->{name}{strings}[$_]) {
  62             print "Deleting string $_\n";
  63         }
  64         $font->{name}{strings}[$_] = undef;
  65     }
  66
  67     for (1, 3, 5) {
  68         set_name($font, $_, '', $verbose);
  69     }
  70
  71     for (4, 6) {
  72         set_name($font, $_, '-', $verbose);
  73     }
  74 }
  75
  76 sub strip_post {
  77     my ($font, $verbose) = @_;
  78
  79     print "Stripping post table\n" if $verbose;
  80
  81     # Replace it with the minimum necessary to work in browsers
  82     # (particularly Opera is a bit fussy)
  83     my $data = pack NNnnNNNNN => 0x10000, 0,  0, 0,  0, 0, 0, 0, 0;
  84     $font->{post} = new Font::TTF::Table(dat => $data);
  85 }
  86
  87 sub main {
  88     my $verbose = 0;
  89     my $all;
  90     my $names;
  91     my $post;
  92
  93     my $result = GetOptions(
  94         'verbose' => \$verbose,
  95         'all' => \$all,
  96         'names' => \$names,
  97         'post' => \$post,
  98     ) or help();
  99
 100     @ARGV == 2 or help();
 101
 102     if (not ($all or $names or $post)) { help(); }
 103
 104     my ($input_file, $output_file) = @ARGV;
 105
 106     my $font = Font::TTF::Font->open($input_file) or die "Error opening $input_file: $!";
 107
 108     strip_names($font, $verbose) if $all or $names;
 109     strip_post($font, $verbose) if $all or $post;
 110
 111     $font->out($output_file);
 112
 113     $font->release;
 114 }