scripts/create_fullembed_file

   1 #!/usr/bin/perl
   2
   3 # usage:
   4 #     create_fullembed_file <mybook.log >fullembed.map
   5 # see http://tex.stackexchange.com/questions/24002/turning-off-font-subsetting-in-pdftex
   6 # This script is not run automatically. If I add another font to a book, I need to re-run it.
   7 # I've noticed some confusing stuff where it seems to leave out exactly one font, but then when I run it again, it works right.
   8 # After running it, always check with pdffonts to make sure that it really worked.
   9 # Can make a copy of the old fullembed.map and compare against it to make sure that fonts haven't been incorrectly left out.
  10
  11 use strict;
  12
  13 my $default_map = `kpsewhich pdftex.map`;
  14 open(F,"<$default_map");
  15 my @map = ();
  16 while (my $line=<F>) {
  17   chomp $line;
  18   # yvtri8r VenturisADF-Italic <8r.enc <yvtri8a.pfb "TeXBase1Encoding ReEncodeFont"
  19   # "..." may also be before <'s; just eliminate it:
  20   $line =~ s/".*"//;
  21   #print "=$line=\n";
  22   push @map,$line;
  23
  24 }
  25 close(F);
  26
  27 local $/; # slurp whole file
  28
  29 my $log = <>;
  30
  31 #print "encs:\n";
  32 my @enc = (''); # null string is because some lines in pdftex.map have no .enc
  33 while ($log =~ /{([^}]+\.enc)}/g) {
  34   my $enc = $1;
  35   $enc =~ s/\n//g;
  36   if ($enc =~ /([^\/]+)\.enc/) {
  37     my $tail = $1;
  38     #print "enc=$tail\n";
  39     push @enc,$tail;
  40   }
  41 }
  42
  43 #print "pfbs:\n";
  44 my @pfb = ();
  45 while ($log =~ /<([^>]+\.pfb)>/g) {
  46   my $pfb = $1;
  47   $pfb =~ s/\n//g;
  48   if ($pfb =~ /([^\/]+\.pfb)/) {
  49     my $tail = $1;
  50     #print "$tail\n";
  51     push @pfb,$tail;
  52   }
  53
  54 }
  55
  56 foreach my $enc(@enc) {
  57   my $e = quotemeta $enc;
  58   foreach my $pfb(@pfb) {
  59     my $p = quotemeta $pfb;
  60     foreach my $map(@map) {
  61       #if ($pfb =~ /tipasl10/ && $enc eq '') {print "trying enc=$enc, pfb=$pfb, map=$map\n"}
  62       if ( $map =~/$p/ && (($enc ne '' && $map =~ /$e/) || ($enc eq '' && ! ($map =~ /\.enc/)))) {
  63         $map =~ s/(<[^ ]+.pfb)/<$1/;
  64         #print "enc=$enc, pfb=$pfb, map=$map\n";
  65         print "$map\n";
  66       }
  67     }
  68   }
  69 }