New EPUB builder, other minor changes.
[librarian.git] / src / 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 }