#!@@PERL@@ # mkpkfontdir: a simple tool for manipulation of TeX pk fonts directories. # # This utility can create various kind of pk fonts directories # structures: fully TDS-conformant, organized by supplier and type or # just by supplier, or not organized at all, as one wants... # The only assumption made by this program is that every pk file has # a corresponding tfm file somewhere, and that the tfm files are correctly # installed (i.e. if they are Not installed in a TDS-conformant structure, # you will not be able to obtain a TDS-conformant pk tree). # # To get usage, just 'mkpkfontdir --help'. # # Copyright (C) 1995, Yves Arrouye # # (By the way, I don't write Perl usually, so please don't flame me # for bad use of it.) # Customize what follows if needed (or do it in the Makefile, it's better) # Known MetaFont modes that are not in modes.mf $knownmodes{'gsftopk'} = 'gsftopk'; $knownmodes{'ps2pk'} = 'ps2pk'; $TEXMF = $ENV{"TEXMF"}; $TEXMF || ($TEXMF = '@@TEXMF@@'); $VARTEXMF = $ENV{"VARTEXMF"}; $VARTEXMF || ($VARTEXMF = $TEXMF); $dft_fontdir = "@@FONTDIR@@"; $dft_destdir = "@@DESTDIR@@"; $dpi_regexp = "s/^/dpi/"; # How to generate the dpi directory name. $loc_tfmdir = "@@LOC_TFMDIR@@"; # Location of tfm files under $opt_fontdir $loc_tfmdirname = &basename($loc_tfmdir); $loc_pkdir = "@@LOC_PKDIR@@"; # Location of pk directory under # $opt_fontdir. We assume that this # directory will contain only # directories corresponding to modes. $loc_unknowndir = "@@LOC_UNKNOWNDIR@@"; $loc_unknownmode = "@@LOC_UNKNOWNMODE@@"; $loc_modesmf = "@@LOC_MODESMF@@"; # Where is modes.mf $use_kpsewhich = "@@USE_KPSEWHICH@@"; $tds_default = @@TDS_DEFAULT@@; $tds_always = @@USE_TDSNAMES@@; $test_longnames = @@TEST_LONGNAMES@@; # Do not touch what is here! # normalname(filename) # # Return the name of a file without double slashs sub normalname { local($file) = @_; $file =~ s,/+,/,g; return $file; } # basename(filename) # basename(filename, extregexp) # # Return the base name of a file. sub basename { local($fullname, $ext) = @_; local($basename) = $fullname; $basename =~ s,(.*/)?([^/]+),$2,; $ext && $basename =~ s,$ext$,,; $basename; } # dirname(filename) # # Return the directory part of a file, with no trailing slash. # sub dirname { local($fullname) = @_; if (!($fullname =~ s,/[^/]+/*$,,)) { $fullname = '.' unless $fullname eq '/'; } return $fullname; } # mkdirs(path, mode) # # Makes all directories necessary to create path. Returns '' if # successful, the partial path otherwise (the last directory being # the one that produced the error). # # mkdirs2(path, mode) # # Makes all directories necessary to create path. Returns a list of # directories created. sub mkdirs { local($path, $mode) = @_; local($builded) = ($path =~ s/^\/// ? '' : '.'); foreach $dir (split('/', $path)) { # There's a problem with mkdir returning 0 when there is no error on # Linux, so we'll create and test. mkdir("$builded/$dir", $mode); if (! -d "$builded/$dir") { return "$builded/$dir"; } $builded .= "/$dir"; } return ''; } sub mkdirs2 { local($path, $mode) = @_; local($builded) = ($path =~ s/^\/// ? '' : '.'); local(@allpaths); foreach $dir (split('/', $path)) { # There's a problem with mkdir returning 0 when there is no error on # Linux, so we'll create and test. $builded .= "/$dir"; if (! -d "$builded") { mkdir("$builded", $mode); if (! -d "$builded") { last; } $allpaths[$#allpaths + 1] = $builded; } } return @allpaths; } # rmdirs(path) # # Recursively delete empty directories. sub rmdirs { local($path) = @_; while (rmdir($path)) { $path = &dirname($path); } } # mfmode(mode, modesmf) # # Return mode iff mode is present in modesmf, '' otherwise. sub mfmode { local($mode, $modesmf) = @_; if (! -r $modesmf) { return ''; } if (open(MODESMF, "<$modesmf")) { while () { if (/^$mode\s+:=/ || /^mode_def\s+$mode\s/) { return $mode; } } } return ''; } # tfmpath(fontname) # # Return the full path of the .tfm file for a given file (assuming it is a # font file, of course). # Quick hack: if $use_kpathsea is null, use a find, but the $tfmdir var # must be set! sub tfmpath { local($name) = @_; local($cmd, $path); $name = &basename($name, '\.[^.]*'); if ($use_kpsewhich) { $cmd = "kpsewhich $name.tfm"; } else { if ($tfmdir eq '') { $tfmdir = "$opt_fontdir/$loc_tfmdir"; } # We could use locate first here, but on some systems it's find and # the syntax varies, so I don't want to: please use kpsewhich! $cmd = "2>/dev/null find $tfmdir -name $name.tfm -print"; } $path=`$cmd`; chop($path); if ($path eq '') { $path = $loc_unknowndir; } return $path; } # fontdirpath(filename) # # Return the path where a font should be installed. For example, on # my system the cmr10.tfm file is (logically) installed in public/cm # under $TEXMF/fonts/tfm, thus its fontpath is public/cm. sub fontdirpath { local($name) = @_; local($path) = &tfmpath($name); $path =~ s,^(.*/)?$loc_tfmdirname/,,; $path =~ s,/[^/]*$,,; $path; } # pkfontnameparts(fontname) # # Return the components (base name and dpi) of a fontname: # # /some/path/font.300pk -> (font, 300) # /some/path/dpi329/font.pk -> (font, 329) sub pkfontnameparts { local($fontname) = @_; local($basename); local($dpi); if ($fontname =~ /dpi(\d+)\/([^\/]*)\.pk$/) { $basename = $2; $dpi = $1; } else { $basename = &basename($fontname); ($dpi = $basename) =~ s,.*\.(\d+)pk,$1,; $basename =~ s,\.${dpi}pk,,; } return ($basename, $dpi); } # strippath(path, level) # # Strip a path by removing a certain number of levels in it, # starting from the end: # # public/cm/cmbsy10.tfm, 1 -> public/cmbsy10.tfm # public/cm/cmbsy10.tfm, 2 -> cmbsy10.tfm # # restrictpath(path, level) # # Restrict path to level components. # # prunepath(path, level) # # Calls restrictpath if level is positive, strippath otherwise (after # making level positive). Note that level is decremented if positive, # so that prunepath($path, 1) means restrict to 0 components. sub strippath { local($path, $level) = @_; while ($level-- > 0 && $path =~ /\//) { $path =~ s,[^/]*/([^/]*)$,$1,; } $path; } sub restrictpath { local($path, $level) = @_; local($pathcopy) = $path; if ($pathcopy !~ m,^/,) { $pathcopy = "/$pathcopy"; } $pathcopy =~ s,/+,/,g; $pathcopy =~ s,[^/],,g; $level = length($pathcopy) - $level - 1; while ($level-- > 0) { $path =~ s,(.*/)?[^/]+/([^/]*),$1$2,; } return $path; } sub prunepath { local($path, $level) = @_; if ($level > 0) { return &restrictpath($path, $level - 1); } else { return &strippath($path, -$level); } } # pkfontpath(fontname, tds, level) # # Return where to install a font in a font tree. # The tds argument indicate whether we should generate a # TDS-conforming subdirectory level dpi$pkdpi. # The level argument is passed to prunepath. sub pkfontpath { local($fontname, $tds, $level) = @_; local($fontdirpath) = &prunepath(&fontdirpath($fontname) . "/", $level); local($basename, $dpi) = &pkfontnameparts($fontname); local($fontpath); if ($tds) { $dpi =~ $dpi_regexp; $fontpath = "$fontdirpath" . "dpi$dpi/$basename.pk"; } else { $fontpath = "$fontdirpath$basename.${dpi}pk"; } return $fontpath; } # sub mkpkfontdir { local($dir, $dftmode, $fontdir, $destdir, $replace, $link, $tds, $level, $pktype, $usemodesmf, $guess, $writepaths, $verbose, $simulate) = @_; local($pk) = &basename($loc_pkdir); local($nwarns) = 0; # Accept files too, because find is okay with that and we can use the # tool in MakeTeXPK. $tfmdir = "$fontdir/$loc_tfmdir"; $destdir = "$destdir/$loc_pkdir"; # Check for the kind of links we can make if ($link eq 'symlink') { if (eval 'symlink("","");', $@ ne '') { $link = 'link'; } } local($move) = $link ? ($link eq 'link' ? "+>" : "->") : "=>"; # Now move or link each file $dir = &normalname($dir); foreach $file (`2>/dev/null find $dir -type f -print`) { local($mode, $mfmode); local($guessing) = 0; chop($file); if (!($file =~ /pk$/)) { next; } if ($verbose) { print "$file\n"; } $mode = $dftmode; # Get the mode from pktype is asked to if ($pktype) { $mfmode = `2>/dev/null pktype $file | grep "'mode=.*'"`; chop($mfmode); if ($mfmode =~ s/.*'mode=(.*).*'/$1/) { $mode = $mfmode; } else { print STDERR &basename($0), ": pktype does not know mode for $file", ($guess ? ", guessing " : ""); $guessing = 1 unless !$guess; } } # If no mode is specified, try to get it from the file path. # Note that if the mode was affected on the command-line, there # is no guess. if ($mode eq '' && $guess) { $mode = $file; if (!($mode =~ s,(.*/)?$pk/([^/]+)/.*,$2,)) { $mode = ''; } } $mfmode = $mode; if ($mode && $usemodesmf && !$knownmodes{$mode}) { $mode = &mfmode($mfmode, $loc_modesmf); } if ($guessing) { print STDERR ($mode ? $mode : $loc_unknownmode), "\n"; } if ($mode eq '') { if ($guessing) { print STDERR "\n"; } print STDERR &basename($0), ": unknown mode \"$mfmode\" for $file, using $loc_unknownmode\n"; $mfmode = $loc_unknownmode; } local($dest) = "$destdir/$mfmode/" . &pkfontpath($file, $tds, $level); $dest = &normalname($dest); if ($dest ne $file) { local($built); if ($verbose) { print " $move $dest\n"; } if (-f $dest) { if (!$replace) { print STDERR &basename($0), ": will not overwrite $dest with $file\n"; ++$nwarns; print "$file\n" if $writepaths; next; } else { unlink($dest); } } if ($dest =~ m,$destdir/$mfmode/$loc_unknowndir/,) { print STDERR &basename($0), ": $file has unknown font path (obtained $dest)\n"; } if ($simulate) { print "$dest\n" if $writepaths; next; } if ($built = &mkdirs(&dirname($dest), 0777)) { print STDERR &basename($0), ": cannot create $built: $!\n"; ++$nwarns; next; } if ($link) { if (!(eval "$link(\"$file\", \"$dest\")")) { print STDERR &basename($0), ": cannot $link $file to $dest\n"; print "$file\n" if $writepaths; ++$nwarns; next; } } else { if (system("cp $file $dest") == 0) { unlink($file); &rmdirs(&dirname($file)); } else { print STDERR &basename($0), ": cannot copy $file to $dest\n"; print "$file\n" if $writepaths; ++$nwarns; next; } } } elsif ($verbose) { print " == $dest\n"; } print "$dest\n" if $writepaths; } return $nwarns; } # Now for the program @@USE_GETOPTS@@; # We do not use File'Basename because we supply the routines we want. sub usage { local($code) = @_; local($me) = &basename($0); if ($code) { select STDERR; } print "usage: $me"; print " [ --version ]"; print " [ -h, --help ]"; print " [ -v, --verbose ]"; print " [ -w, --write-paths ]"; print " [ -n, --noaction ]"; print " [ -m, --mode modespec ]"; print " [ -M, --use-modesmf [ f ] ]"; print " [ -P, --use-pktype ]"; print " [ -g, --guess-mode ]"; print " [ -f, --fontdir fontdir ]"; print " [ -d, --destdir destdir ]"; print " [ -o, --overwrite ]"; print " [ -l, --link | -s, --symbolic-link ]"; print " [ -t, --tds-names | -L, --long-names ]"; print " [ -p, --prune n | -P, -r, --restrict n ]"; print " directory-or-pkfile ...\n"; if (!$code) { # Give description print <\n"; } if ($opt_help) { &usage(0); } if ($opt_long_names) { if ($tds_always) { print STDERR &basename($0), ": only TDS names are allowed, do not use -L or --long-names\n"; exit 2; } if ($test_longnames) { local($temp) = $ENV{"TMPDIR"} || $ENV{"TEMP"} || "/tmp"; local($ok) = 0; local($oklong) = 0; local(@builded) = mkdirs2($temp, 0777); if ($ok = -d $temp) { local($dummy) = "$temp/font.300pk"; if ($ok = open(DUMMY, ">$dummy")) { close(DUMMY); $oklong = -f $dummy; unlink($dummy); } } if ($ok == 0) { print STDERR &basename($0), ": unable to test for long names; please contact your sysadmin\n"; for ($i = $#builded; $i >= 0; --$i) { rmdir($builded[$i]); } exit(3); } for ($i = $#builded; $i >= 0; --$i) { rmdir($builded[$i]); } if ($oklong == 0) { print STDERR &basename($0), ": only TDS names are supported, do not use -L or --long-names\n"; } } } else { $opt_tds_names = $tds_default; } if ($opt_link) { $opt_link = ($opt_symbolic ? 'symlink' : 'link'); } if ($opt_prune) { $opt_restrict = -$opt_prune; } if (defined($opt_use_modesmf)) { if ($opt_use_modesmf) { $loc_modesmf = $opt_use_modesmf; } if (! - e $loc_modesmf) { print STDERR &basename($0), ": modes file $loc_modesmf does not exist\n"; exit(5); } $opt_use_modesmf = 1; } # Treat the modes specification if any local($default_mode); if ($opt_mode) { foreach $modespec (split(',', $opt_mode)) { local($change) = 0; local($mode, $alias); if ($modespec =~ /(.*)=(.*)/) { $alias = $1; $mode = $2; } else { $alias = $mode = $modespec; $change = 1; } if ($knownmodes{$mode} || grep("^$mode\$", values %knownmodes) || !$opt_use_modesmf || &mfmode($mode, $loc_modesmf)) { $knownmodes{$alias} = $mode; if ($change) { $default_mode=$mode; } } else { print STDERR &basename($0), ": unknown mode in specification $modespec, ignored\n"; } } } # Arrange font and destination directories if (!$opt_fontdir) { $opt_fontdir = $dft_fontdir; if (!$opt_destdir) { $opt_destdir = $dft_destdir; } } elsif (!$opt_destdir) { $opt_destdir = $opt_fontdir; } # Should we guess? if (!$opt_use_pktype) { $opt_guess_mode = 1; } # Go for each directory foreach $dir (@ARGV) { if (-e $dir) { if ($dir !~ m,^/,) { $dir = `cd $dir && pwd`; chop($dir); } } else { print STDERR &basename($0), ": $dir: no such file or directory, ignored\n"; next; } if (&mkpkfontdir($dir, $default_mode, $opt_fontdir, $opt_destdir, $opt_overwrite, $opt_link, $opt_tds_names, $opt_restrict, $opt_use_pktype, $opt_use_modesmf, $opt_guess_mode, $opt_write_paths, $opt_verbose, $opt_noaction)) { exit(2); } exit(0); }