font/devpdf/util/BuildFoundries.pl

   1 #!/usr/bin/perl -w
   2 #
   3 #   BuildFoundries   : Given a Foundry file generate groff and download files
   4 #   Deri James       : Monday 07 Feb 2011
   5
   6 # Copyright (C) 2011 Free Software Foundation, Inc.
   7 #      Written by Deri James <deri@chuzzlewit.demon.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 ANY
  17 # 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
  26 my $where=shift||'';
  27 my $devps=shift||'../devps';
  28 chdir $where if $where ne '';
  29 my (%foundry,%flg,@downloadpreamble,%download);
  30 my $GSpath=FindGSpath();
  31 my $warn=0;
  32 my $lct=0;
  33 my $foundry=''; # the default foundry
  34
  35 LoadDownload("download");
  36 LoadFoundry("Foundry");
  37 WriteDownload("download");
  38
  39 exit 0;
  40
  41
  42
  43 sub LoadFoundry
  44 {
  45     my $fn=shift;
  46     my $foundrypath='';
  47
  48     open(F,"<$fn") or die "No $fn file found";
  49
  50     while (<F>)
  51     {
  52         chomp;
  53         $lct++;
  54         s/\r$//;        # in case edited in windows
  55
  56         s/\s*#.*?$//;   # remove comments
  57
  58         next if $_ eq '';
  59
  60         if (m/^[A-Za-z]=/)
  61         {
  62             my (@f)=split('=');
  63             $flg{$f[0]}=$f[1];
  64             next;
  65         }
  66
  67         my (@r)=split('\|');
  68
  69         if (lc($r[0]) eq 'foundry')
  70         {
  71             $foundry=uc($r[1]);
  72             $foundrypath=$r[2].' : '.$devps;
  73             $foundrypath=~s/\(gs\)/$GSpath /;
  74         }
  75         else
  76         {
  77             # 0=groff font name
  78             # 1=IsBase Y/N (one of PDFs 14 base fonts)
  79             # 2=afmtodit flag
  80             # 3=map file
  81             # 4=encoding file
  82             # 5=font file
  83             # 6=afm file
  84
  85             if (!defined($r[6]) or $r[6] eq '')
  86             {
  87                 # if no afm file, have a guess!
  88                 $r[6]=substr($r[5],0,-3)."afm";
  89             }
  90
  91             my $gfont=($foundry eq '')?$r[0]:"$foundry-$r[0]";
  92
  93             if ($r[2] eq '')
  94             {
  95                 # Don't run afmtodit, just copy the grops font file
  96
  97                 my $gotf=1;
  98                 my $gropsfnt=LocateFile($devps,$r[0],0);
  99
 100                 if ($gropsfnt ne '' and -r "$gropsfnt")
 101                 {
 102                     my $psfont=UseGropsVersion($gropsfnt);
 103                     if (!PutDownload($psfont,LocatePF($foundrypath,$r[5]),uc($r[1])))
 104                     {
 105                         if (uc($r[1]) ne 'Y')
 106                         {
 107                             $gotf=0;
 108                             my $fns=join(',',split('!',$r[5]));
 109                             Msg(0,"Unable to locate font(s) $fns on the given path(s)");
 110                             unlink $gfont;      # Unable to find the postscript file for the font just created by afmtodit
 111                         }
 112                     }
 113                     print STDERR "Copied grops font $gfont...\n" if $gotf;
 114
 115                 }
 116                 else
 117                 {
 118                     Msg(0,"Can't read grops font '$r[0]' for Foundry '$foundry'");
 119                 }
 120             }
 121             else
 122             {
 123                 # We need to run afmtodit to create this groff font
 124                 my $psfont=RunAfmtodit($gfont,LocateAF($foundrypath,$r[6]),$r[2],$r[3],$r[4]);
 125
 126                 if ($psfont)
 127                 {
 128                     if (!PutDownload($psfont,LocatePF($foundrypath,$r[5]),uc($r[1])))
 129                     {
 130                         unlink $gfont;  # Unable to find the postscript file for the font just created by afmtodit
 131                     }
 132                     else
 133                     {
 134                         print STDERR "Generated $gfont...\n";
 135                     }
 136                 }
 137                 else
 138                 {
 139                     Msg(0,"Failed to create groff font '$gfont' by running afmtodit");
 140                 }
 141             }
 142         }
 143     }
 144
 145     close();
 146 }
 147
 148 sub RunAfmtodit
 149 {
 150     my $gfont=shift;
 151     my $afmfile=shift;
 152     my $flags=shift;
 153     my $map=shift||'';
 154     my $enc=shift||'';
 155     my $psfont='';
 156
 157     $enc="-e 'enc/$enc'" if $enc;
 158     $map="'map/$map'" if $map;
 159
 160     my $cmd='afmtodit -c -dDESC';
 161
 162     foreach my $f (split('',$flags))
 163     {
 164         if (!exists($flg{$f}))
 165         {
 166             Msg(0,"Can't use undefined flag '$f' in calling afmtodit for groff font '$gfont'");
 167             return('');
 168         }
 169
 170         $cmd.=" $flg{$f}";
 171     }
 172
 173     system("$cmd $enc '$afmfile' $map $gfont 2>/dev/null");
 174
 175     if ($?)
 176     {
 177         unlink $gfont;
 178         return('');
 179     }
 180
 181     if (open(GF,"<$gfont"))
 182     {
 183         my (@gf)=(<GF>);
 184         my @ps=grep(/^internalname /,@gf);
 185         if ($#ps == 0)  # Just 1 match
 186         {
 187             (undef,$psfont)=split(' ',$ps[0],2);
 188             chomp($psfont);
 189         }
 190         else
 191         {
 192             Msg(0,"Unexpected format for grops font '$gfont' for Foundry '$foundry' - ignoring");
 193         }
 194
 195         close(GF);
 196     }
 197
 198     return($psfont);
 199 }
 200
 201 sub LocateAF
 202 {
 203     my $path=shift;
 204     my $file=shift;
 205
 206     return(LocateFile($path,$file,1));
 207 }
 208
 209 sub LocatePF
 210 {
 211     my $path=shift;
 212     my $file=shift;
 213
 214     return(LocateFile($path,$file,0));
 215 }
 216
 217 sub LocateFile
 218 {
 219     my $path=shift;
 220     my $files=shift;
 221     my $tryafm=shift;
 222     return(substr($files,1)) if substr($files,0,1) eq '*';
 223
 224     foreach my $file (split('!',$files))
 225     {
 226     if ($file=~m'/')
 227     {
 228         # path given with file name so no need to search the paths
 229
 230         if (-r $file)
 231         {
 232             return($file);
 233         }
 234
 235         if ($tryafm and $file=~s'type1/'afm/'i)
 236         {
 237             if (-r "$file")
 238             {
 239                 return($file);
 240             }
 241         }
 242
 243         return('');
 244     }
 245
 246         if ($path eq '(tex)')
 247     {
 248         my $res=`kpsewhich $file`;
 249         return '' if $?;
 250         chomp($res);
 251         return($res);
 252     }
 253
 254         my (@paths)=split(/ (:|;)/,$path);
 255
 256     foreach my $p (@paths)
 257     {
 258             next if !defined($p) or $p eq ';' or $p eq ':';
 259         $p=~s/^\s+//;
 260         $p=~s/\s+$//;
 261
 262         next if $p=~m/^\%rom\%/;        # exclude %rom% paths (from (gs))
 263
 264         if (-r "$p/$file")
 265         {
 266             return("$p/$file");
 267         }
 268
 269         if ($tryafm and $p=~s'type1/'afm/'i)
 270         {
 271             if (-r "$p/$file")
 272             {
 273                 return("$p/$file");
 274             }
 275         }
 276     }
 277     }
 278
 279     return('');
 280 }
 281
 282 sub FindGSpath
 283 {
 284     my (@res)=`@GROFF_GHOSTSCRIPT_INTERPRETERS@ -h 2>/dev/null`;
 285     return '' if $?;
 286     my $buildpath='';
 287     my $stg=1;
 288
 289     foreach my $l (@res)
 290     {
 291         chomp($l);
 292
 293         if ($stg==1 and $l=~m/^Search path:/)
 294         {
 295             $stg=2;
 296         }
 297         elsif ($stg == 2)
 298         {
 299             if (substr($l,0,1) ne ' ')
 300             {
 301                 $stg=3;
 302             }
 303             else
 304             {
 305                 $l=~s/^\s+//;
 306                 $buildpath.=$l;
 307             }
 308         }
 309     }
 310
 311     return($buildpath);
 312 }
 313
 314 sub UseGropsVersion
 315 {
 316     my $gfont=shift;
 317     my $psfont='';
 318     my (@gfa)=split('/',$gfont);
 319     my $gfontbase=pop(@gfa);
 320
 321     if (open(GF,"<$gfont"))
 322     {
 323         my (@gf)=(<GF>);
 324         my @ps=grep(/^internalname /,@gf);
 325         if ($#ps == 0)  # Just 1 match
 326         {
 327             (undef,$psfont)=split(' ',$ps[0],2);
 328             chomp($psfont);
 329         }
 330         else
 331         {
 332             Msg(0,"Unexpected format for grops font '$gfont' for Foundry '$foundry' - ignoring");
 333         }
 334
 335         close(GF);
 336
 337         if ($psfont)
 338         {
 339             if (open(GF,">$gfontbase"))
 340             {
 341                 local $"='';
 342                 print GF "@gf";
 343                 close(GF);
 344             }
 345             else
 346             {
 347                 $psfont='';
 348                 Msg(0,"Failed to create new font '$gfont' for Foundry '$foundry'");
 349             }
 350         }
 351         else
 352         {
 353             Msg(0,"Failed to locate postscript internalname in grops font '$gfont' for Foundry '$foundry'");
 354         }
 355
 356         close(GF);
 357     }
 358     else
 359     {
 360         Msg(0,"Failed to open grops font '$gfont' for Foundry '$foundry'");
 361     }
 362
 363     return($psfont);
 364 }
 365
 366 sub PutDownload
 367 {
 368     my $psfont=shift;
 369     my $pffile=shift;
 370     my $IsBase14=shift;
 371     my $key="$foundry $psfont";
 372
 373     delete($download{$key}), return 0 if ($pffile eq '');
 374
 375     $pffile='*'.$pffile if $IsBase14 eq 'Y'; # This signals to gropdf to only edmbed if -e given
 376     $download{$key}=$pffile;
 377
 378     return 1;
 379 }
 380
 381 sub LoadDownload
 382 {
 383     my $fn=shift;
 384     my $top=1;
 385
 386     return if !open(F,"<$fn");
 387
 388     while (<F>)
 389     {
 390         chomp;
 391         s/\r$//;        # in case edited in windows
 392
 393         if ($top and substr($_,0,1) eq '#' or $_ eq '')
 394         {
 395             # Preserve comments at top of download file
 396
 397             push(@downloadpreamble,$_);
 398             next;
 399         }
 400
 401         $top=0;
 402         s/\s*#.*?$//;   # remove comments
 403
 404         next if $_ eq '';
 405
 406         my (@r)=split(/\t+/);
 407         my $key=$r[1];
 408         $key="$r[0] $r[1]";
 409         $download{$key}=$r[2];
 410     }
 411
 412     close(F);
 413 }
 414
 415 sub WriteDownload
 416 {
 417     my $fn=shift;
 418     my $top=1;
 419
 420     open(F,">$fn") or die "Can't Create new file '$fn'";
 421
 422     print F join("\n",@downloadpreamble),"\n";
 423
 424     foreach my $k (sort keys %download)
 425     {
 426         my ($f,$ps)=split(/ /,$k);
 427         print F "$f\t$ps\t$download{$k}\n";
 428     }
 429
 430     close(F);
 431 }
 432
 433 sub Msg
 434 {
 435     my $sev=shift;
 436     my $msg=shift;
 437
 438     if ($sev)
 439     {
 440         print STDERR "Error: line $lct: $msg\n";
 441         exit 2;
 442     }
 443     else
 444     {
 445         print STDERR "Warning: line $lct: $msg\n";
 446         $warn=1;
 447     }
 448 }