font/devpdf/util/BuildFoundries.pl

   1 #!/usr/bin/perl
   2 #
   3 # BuildFoundries: Given a Foundry file, generate groff font description
   4 # files and a "download" file so gropdf can embed fonts in PDF output.
   5 #
   6 # Copyright (C) 2011-2020 Free Software Foundation, Inc.
   7 #      Written by Deri James <deri@chuzzlewit.myzen.co.uk>
   8 #
   9 # This file is part of groff.
  10 #
  11 # groff is free software; you can redistribute it and/or modify it under
  12 # the terms of the GNU General Public License as published by the Free
  13 # Software Foundation, either version 3 of the License, or
  14 # (at your option) any later version.
  15 #
  16 # groff is distributed in the hope that it will be useful, but WITHOUT
  17 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  18 # FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  19 # for more details.
  20 #
  21 # You should have received a copy of the GNU General Public License
  22 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 use strict;
  25 use Getopt::Long;
  26 use warnings;
  27
  28 my $pathsep='@PATH_SEPARATOR@';
  29
  30 my $check=0;
  31 my $dirURW='';
  32 my $beStrict=0;
  33
  34 GetOptions("check" => \$check, "dirURW=s" => \$dirURW,
  35            "strict" => \$beStrict);
  36
  37 (my $progname = $0) =~s @.*/@@;
  38 my $where=shift||'';
  39 my @d=(split(':',shift||'../devps'));
  40 my $devps=\@d;
  41 chdir $where if $where ne '';
  42 my (%flg,@downloadpreamble,%download);
  43 my $GSpath=FindGSpath();
  44 my $lct=0;
  45 my $foundry=''; # the default foundry
  46 my $notFoundFont=0;
  47
  48 if ($check)
  49 {
  50     CheckFoundry("Foundry.in");
  51     exit $notFoundFont;
  52 }
  53 else
  54 {
  55     LoadDownload("download"); # not required
  56     LoadFoundry("Foundry");
  57     WriteDownload();
  58 }
  59 exit 0;
  60
  61
  62
  63 sub LoadFoundry
  64 {
  65     my $fn=shift;
  66     my $foundrypath;
  67     $notFoundFont=0;
  68
  69     open(F,"<$fn") or Die("file '$fn' not found or not readable");
  70
  71     while (<F>)
  72     {
  73         chomp;
  74         $lct++;
  75         s/\r$//;        # in case edited in windows
  76
  77         s/\s*#.*?$//;   # remove comments
  78
  79         next if $_ eq '';
  80
  81         if (m/^[A-Za-z]=/)
  82         {
  83             my (@f)=split('=');
  84             $flg{$f[0]}=$f[1];
  85             next;
  86         }
  87
  88         my (@r)=split('\|');
  89
  90         if (lc($r[0]) eq 'foundry')
  91         {
  92             Warn("\nThe path(s) used for searching:\n".join(':',@{$foundrypath})."\n") if $notFoundFont;
  93             $foundry=uc($r[1]);
  94             $foundrypath=[];
  95             push(@{$foundrypath},$dirURW) if $dirURW;
  96             push(@{$foundrypath},(split(':',$r[2])),@{$devps});
  97             foreach my $j (0..$#{$foundrypath})
  98             {
  99                 if (defined($foundrypath->[$j])
 100                     && $foundrypath->[$j]=~m'\s*\(gs\)')
 101                 {
 102                     splice(@{$foundrypath},$j,1,@{$GSpath});
 103                 }
 104             }
 105             $notFoundFont=0;
 106         }
 107         else
 108         {
 109             # 0=groff font name
 110             # 1=IsBase Y/N (one of PDFs 14 base fonts)
 111             # 2=afmtodit flag
 112             # 3=map file
 113             # 4=encoding file
 114             # 5=font file
 115
 116             my $gfont=($foundry eq '')?$r[0]:"$foundry-$r[0]";
 117
 118             if ($r[2] eq '')
 119             {
 120                 # Don't run afmtodit; just copy the groff font
 121                 # description file for grops.
 122                 my $gotf=1;
 123                 my $gropsfnt=LocateFile($devps,$r[0],0);
 124                 if ($gropsfnt ne '' and -r "$gropsfnt")
 125                 {
 126                     my $psfont=UseGropsVersion($gropsfnt);
 127                     # To be embeddable in PDF, the font file name itself
 128                     # needs to be located and written to "download".
 129                     if (!PutDownload($psfont,
 130                                      LocatePF($foundrypath,$r[5]),
 131                                               uc($r[1])))
 132                     {
 133                         if (uc($r[1]) ne 'Y')
 134                         {
 135                             $gotf=0;
 136                             my $fns=join(', ',split('!',$r[5]));
 137                             Warn("groff font '$gfont' will not be"
 138                                  . " available for PDF output; unable"
 139                                  . " to locate font file(s): $fns");
 140                             $notFoundFont=1;
 141                             unlink $gfont;
 142                         }
 143                     }
 144                     Notice("copied grops font $gfont") if $gotf;
 145
 146                 }
 147                 else
 148                 {
 149                     Warn("Can't read grops font '$r[0]' for Foundry '$foundry'");
 150                 }
 151             }
 152             else
 153             {
 154                 # Use afmtodit to create a groff font description file.
 155                 my $afmfile=LocateAF($foundrypath,$r[5]);
 156                 if (!$afmfile) {
 157                     my $sub=\&Warn;
 158                     $sub=\&Die if ($beStrict);
 159                     &$sub("cannot locate AFM file for font '$gfont'");
 160                     next;
 161                 }
 162                 my $psfont=RunAfmtodit($gfont,$afmfile,$r[2],$r[3],$r[4]);
 163
 164                 if ($psfont)
 165                 {
 166                     if (!PutDownload($psfont,LocatePF($foundrypath,$r[5]),uc($r[1])))
 167                     {
 168                         unlink $gfont;  # Unable to find the postscript file for the font just created by afmtodit
 169                     }
 170                     else
 171                     {
 172                         Notice("generated $gfont");
 173                     }
 174                 }
 175                 else
 176                 {
 177                     Warn("Failed to create groff font '$gfont' by running afmtodit");
 178                     $notFoundFont=1;
 179                 }
 180             }
 181         }
 182     }
 183
 184     close(F);
 185     Warn("\nThe path(s) used for searching:\n".join(':',@{$foundrypath})."\n") if $notFoundFont;
 186 }
 187
 188 sub RunAfmtodit
 189 {
 190     my $gfont=shift;
 191     my $afmfile=shift;
 192     my $flags=shift;
 193     my $map=shift||'';
 194     my $enc=shift||'';
 195     my $psfont='';
 196
 197     $enc="-e 'enc/$enc'" if $enc;
 198     $map="'map/$map'" if $map;
 199
 200     my $cmd='afmtodit -c -dDESC';
 201
 202     foreach my $f (split('',$flags))
 203     {
 204         if (!exists($flg{$f}))
 205         {
 206             Warn("Can't use undefined flag '$f' in calling afmtodit for groff font '$gfont'");
 207             return('');
 208         }
 209
 210         $cmd.=" $flg{$f}";
 211     }
 212
 213     system("$cmd $enc '$afmfile' $map $gfont");
 214
 215     if ($?)
 216     {
 217         unlink $gfont;
 218         return('');
 219     }
 220
 221     if (open(GF,"<$gfont"))
 222     {
 223         my (@gf)=(<GF>);
 224         my @ps=grep(/^internalname /,@gf);
 225         if ($#ps == 0)  # Just 1 match
 226         {
 227             (undef,$psfont)=split(' ',$ps[0],2);
 228             chomp($psfont);
 229         }
 230         else
 231         {
 232             Warn("Unexpected format for grops font '$gfont' for Foundry '$foundry' - ignoring");
 233         }
 234
 235         close(GF);
 236     }
 237
 238     return($psfont);
 239 }
 240
 241 sub LocateAF
 242 {
 243     my $path=shift;
 244     my $file=shift;
 245
 246     return(LocateFile($path,$file,1));
 247 }
 248
 249 sub LocatePF
 250 {
 251     my $path=shift;
 252     my $file=shift;
 253
 254     return(LocateFile($path,$file,0));
 255 }
 256
 257 sub LocateFile
 258 {
 259     my $path=shift;
 260     my $files=shift;
 261     my $tryafm=shift;
 262     return(substr($files,1)) if substr($files,0,1) eq '*';
 263
 264     foreach my $p (@{$path})
 265     {
 266         next if !defined($p) or $p eq ';' or $p eq ':';
 267         $p=~s/^\s+//;
 268         $p=~s/\s+$//;
 269         $p=~s@/+$@@;
 270
 271         next if $p=~m/^\%rom\%/;        # exclude %rom% paths (from (gs))
 272
 273         foreach my $file (reverse(split('!',$files)))
 274         {
 275             if ($tryafm)
 276             {
 277                 if (!($file=~s/\..+$/.afm/))
 278                 {
 279                     # no extenaion
 280                     $file.='.afm';
 281                 }
 282             }
 283
 284             if ($file=~m'/')
 285             {
 286                 # path given with file name so no need to search the paths
 287
 288                 if (-r $file)
 289                 {
 290                     return($file);
 291                 }
 292
 293                 if ($tryafm and $file=~s'type1/'afm/'i)
 294                 {
 295                     if (-r "$file")
 296                     {
 297                         return($file);
 298                     }
 299                 }
 300
 301                 return('');
 302             }
 303
 304             if ($path eq '(tex)')
 305             {
 306                 my $res=`kpsewhich $file`;
 307                 return '' if $?;
 308                 chomp($res);
 309                 return($res);
 310             }
 311
 312             if (-r "$p/$file")
 313             {
 314                 return("$p/$file");
 315             }
 316
 317             my $ap=$p;
 318
 319             if ($tryafm and $ap=~s'type1/'afm/'i)
 320             {
 321                 if (-r "$ap/$file")
 322                 {
 323                     return("$ap/$file");
 324                 }
 325             }
 326         }
 327     }
 328
 329     return('');
 330 }
 331
 332 sub FindGSpath
 333 {
 334     my (@res)=`@GHOSTSCRIPT@ -h 2>/dev/null`;
 335     return [] if $?;
 336     my $buildpath=[];
 337     my $stg=1;
 338
 339     foreach my $l (@res)
 340     {
 341         chomp($l);
 342
 343         if ($stg==1 and $l=~m/^Search path:/)
 344         {
 345             $stg=2;
 346         }
 347         elsif ($stg == 2)
 348         {
 349             if (substr($l,0,1) ne ' ')
 350             {
 351                 $stg=3;
 352             }
 353             else
 354             {
 355                 $l=~s/^\s+//;
 356                 $pathsep=';' if substr($l,-1) eq ';';
 357                 push(@{$buildpath},(split("$pathsep",$l)));
 358             }
 359         }
 360     }
 361
 362     return($buildpath);
 363 }
 364
 365 sub UseGropsVersion
 366 {
 367     my $gfont=shift;
 368     my $psfont='';
 369     my (@gfa)=split('/',$gfont);
 370     my $gfontbase=pop(@gfa);
 371
 372     if (open(GF,"<$gfont"))
 373     {
 374         my (@gf)=(<GF>);
 375         my @ps=grep(/^internalname /,@gf);
 376         if ($#ps == 0)  # Just 1 match
 377         {
 378             (undef,$psfont)=split(' ',$ps[0],2);
 379             chomp($psfont);
 380         }
 381         else
 382         {
 383             Warn("Unexpected format for grops font '$gfont' for Foundry '$foundry' - ignoring");
 384         }
 385
 386         close(GF);
 387
 388         if ($psfont)
 389         {
 390             if (open(GF,">$gfontbase"))
 391             {
 392                 local $"='';
 393                 print GF "@gf";
 394                 close(GF);
 395             }
 396             else
 397             {
 398                 $psfont='';
 399                 Warn("Failed to create new font '$gfont' for Foundry '$foundry'");
 400             }
 401         }
 402         else
 403         {
 404             Warn("Failed to locate postscript internalname in grops font '$gfont' for Foundry '$foundry'");
 405         }
 406
 407         close(GF);
 408     }
 409     else
 410     {
 411         Warn("Failed to open grops font '$gfont' for Foundry '$foundry'");
 412     }
 413
 414     return($psfont);
 415 }
 416
 417 sub PutDownload
 418 {
 419     my $psfont=shift;
 420     my $pffile=shift;
 421     my $IsBase14=shift;
 422     my $key="$foundry $psfont";
 423
 424     delete($download{$key}), return 0 if ($pffile eq '');
 425
 426     $pffile='*'.$pffile if $IsBase14 eq 'Y'; # This signals to gropdf to only edmbed if -e given
 427     $download{$key}=$pffile;
 428
 429     return 1;
 430 }
 431
 432 sub LoadDownload
 433 {
 434     my $fn=shift;
 435
 436     return if !open(F,"<$fn");
 437
 438     while (<F>)
 439     {
 440         chomp;
 441         s/\r$//;        # in case edited in windows
 442
 443         if (substr($_,0,1) eq '#' or $_ eq '')
 444         {
 445             # Preserve comments at top of download file
 446
 447             push(@downloadpreamble,$_);
 448             next;
 449         }
 450
 451         s/\s*#.*?$//;   # remove comments
 452
 453         next if $_ eq '';
 454
 455         my (@r)=split(/\t+/);
 456         my $key=$r[1];
 457         $key="$r[0] $r[1]";
 458         $download{$key}=$r[2];
 459     }
 460
 461     close(F);
 462 }
 463
 464 sub WriteDownload
 465 {
 466     print join("\n",@downloadpreamble),"\n";
 467
 468     foreach my $k (sort keys %download)
 469     {
 470         my ($f,$ps)=split(/ /,$k);
 471         print "$f\t$ps\t$download{$k}\n";
 472     }
 473 }
 474
 475 sub Notice {
 476     my $msg=shift;
 477     Msg("notice: $msg");
 478 }
 479
 480 sub Warn {
 481     my $msg=shift;
 482     Msg("warning: line $lct: $msg");
 483 }
 484
 485 sub Die {
 486     my $msg=shift;
 487     Msg("error: $msg");
 488     exit 2;
 489 }
 490
 491 sub Msg {
 492     my $msg=shift;
 493     print STDERR "$progname: $msg\n";
 494 }
 495
 496 sub CheckFoundry
 497 {
 498     my $fn=shift;
 499     my $foundrypath=[];
 500     $notFoundFont=0;
 501
 502     open(F,"<$fn") or Die("file '$fn' not found or not readable");
 503
 504     while (<F>)
 505     {
 506         chomp;
 507         s/\r$//;        # in case edited in windows
 508
 509         s/\s*#.*?$//;   # remove comments
 510
 511         next if $_ eq '';
 512
 513         if (m/^[A-Za-z]=/)
 514         {
 515             next;
 516         }
 517
 518         my (@r)=split('\|');
 519
 520         if (lc($r[0]) eq 'foundry')
 521         {
 522             $foundry=uc($r[1]);
 523             $foundrypath=[];
 524             push(@{$foundrypath},$dirURW) if $dirURW;
 525             push(@{$foundrypath},(split(':',$r[2])),$devps);
 526             foreach my $j (0..$#{$foundrypath})
 527             {
 528                 if ($foundrypath->[$j]=~m'\s*\(gs\)')
 529                 {
 530                     splice(@{$foundrypath},$j,1,@{$GSpath});
 531                 }
 532             }
 533             $notFoundFont=0;
 534         }
 535         else
 536         {
 537             # 0=groff font name
 538             # 1=IsBase Y/N (one of PDFs 14 base fonts)
 539             # 2=afmtodit flag
 540             # 3=map file
 541             # 4=encoding file
 542             # 5=font file
 543
 544             my $gfont=($foundry eq '')?$r[0]:"$foundry-$r[0]";
 545
 546             if ($r[2] eq '')
 547             {
 548                 # Don't run afmtodit, just copy the grops font file
 549
 550                 my $gotf=1;
 551                 my $gropsfnt=LocateFile([$devps],$r[0],0);
 552
 553                 if ($gropsfnt ne '' and -r "$gropsfnt")
 554                 {
 555
 556                 }
 557                 else
 558                 {
 559                     $notFoundFont|=1;
 560                 }
 561             }
 562             else
 563             {
 564                 # We need to run afmtodit to create this groff font
 565                 $notFoundFont|=2 if !LocateAF($foundrypath,$r[5]);
 566                 $notFoundFont|=1 if !LocatePF($foundrypath,$r[5]);
 567             }
 568         }
 569     }
 570
 571     close(F);
 572 }
 573
 574 # Local Variables:
 575 # fill-column: 72
 576 # mode: CPerl
 577 # End:
 578 # vim: set cindent noexpandtab shiftwidth=4 softtabstop=4 textwidth=72: