#! /usr/bin/perl

# mktextfm -- make a new TFM file, because one wasn't found.
# 
# This Perl version is based on the original /bin/sh version:
# 
#   te@informatik.uni-hannover.de, kb@mail.tug.org, and infovore@xs4all.nl.
#   Public domain.
#   RCS Id: mktextfm,v 1.21 1999/05/29 20:39:03 olaf Exp
# 
# 
# Perl version:
# $Id: mktextfm,v 1.9 1999/07/18 23:40:48 jdg Exp $
# Copyright 1999, Julian Gilbey <jdg@debian.org>
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use File::Basename;
use File::Copy;
use TeX::Mktex qw(:DEFAULT mknam_nomfdrivers $MT_FEATURES $TEMPDIR
	$BDPI $MODE);
use TeX::Kpsewhich;
use Cwd;

$progname=basename($0);
$version=strip_quotes(<<'EOV');
:	Perl version: $Id: mktextfm,v 1.9 1999/07/18 23:40:48 jdg Exp $
:	based on /bin/sh version _Id: mktextfm,v 1.21 1999/05/29 20:39:03 olaf Exp $ _
EOV
$version =~ s/_/\$/g;
$usage=strip_quotes(<<EOU);
:	Usage: $progname [--destdir DESTDIR] FONT.
:	
:	Makes a TFM file for FONT, if possible. Use DESTDIR for the root of where
:	to install into, either the absolute directory name to use (if it starts
:	with a /) or relative to the default DESTDIR (if not).
EOU

# We now perform the necessary initialisations.
mktex_opt('destdir=s', \$DEST);

# Where do potential mf driver files go?
":$MT_FEATURES:" =~ /:nomfdrivers:/ && mknam_nomfdrivers();

# All output except for the font location should go to stderr
open SAVEOUT, ">&STDOUT" or die "$progname: can't dup stdout: $!\n";
open STDOUT, ">&STDERR" or die "$progname: can't dup stderr onto stdout: $!\n";

$NAME=basename($ARGV[0], '.tfm');
$MAG=1;
$DPI=$BDPI;

($PKDEST, $TFMDEST) = mktex_names($NAME, $DPI, $MODE, $DEST);

($PKNAME, $PKDESTDIR) = fileparse($PKDEST);
$TFMDESTDIR=dirname($TFMDEST);
$TFMNAME="$NAME.tfm";
$GFNAME="$NAME.${DPI}gf";

if (-r "$TFMDESTDIR/$TFMNAME") {
	print "$progname: $TFMDESTDIR/$TFMNAME already exists.\n";
	print SAVEOUT "$TFMDESTDIR/$TFMNAME\n";
	mktex_upd($TFMDESTDIR, $TFMNAME);
	exit 0;
}

# Try to create the destdir first. Do not create fonts, if this fails.
mktex_dir($TFMDESTDIR);
die "$progname: mktex_dir $TFMDESTDIR failed!\n" if ! -d $TFMDESTDIR;

# Check if this font is supported by hbf2gf else use metafont.
if (system("(hbf2gf -q -t $NAME) >/dev/null 2>&1") >> 8 == 0) {
	$cmd="hbf2gf -g $NAME $DPI";
} else {
	$cmd="mf '\\mode:=$MODE; mag:=$MAG; nonstopmode; input $NAME'";
}

print "$progname: Running $cmd\n";
if (system("$cmd </dev/null") >> 8 != 0) {
	die "$progname: `$cmd' failed\n" unless -f "$NAME.log";
	# There's a log file; we'll check for strange path errors
	open LOG, "<$NAME.log"
		or die "$progname: Can't open $NAME.log file: $!\n";
	$strange=0;
	while (<LOG>) {
		if (/^! Strange path/) {
			$strange++;
		}
		elsif (/^! /) {
			-s "$NAME.log" && move("$NAME.log", $KPSE_DOT);
			die "$progname: `$cmd' failed.  (Log in $KPSE_DOT)\n";
		}
	}
	close LOG
		or die "$progname: problem reading $NAME.log: $!\n";
	$strange &&
		warn "$progname: warning: `$cmd' caused $strange strange path error" .
			($strange>1 ? "s.\n" : ".\n");
}

# hbf2gf just produces a .pl file:
if (-r "$NAME.pl") {
	if (system("pltotf ./$NAME.pl $TFMNAME </dev/null") >> 8 != 0) {
		die "$progname: pltotf failed: $!\n";
	}
}

-r $TFMNAME or die "$progname: `$cmd' failed to make $TFMNAME.\n";

# Install the TFM file carefully, since others may be working simultaneously.
push @cleanfiles, "$TFMDESTDIR/tfm$$.tmp";
unless (move($TFMNAME, "$TFMDESTDIR/tfm$$.tmp")) {
	my $err="$!";
	unlink "$TFMDESTDIR/tfm$$.tmp";
	die "$progname: move of tfm file to destination directory failed: $err\n";
}

unless (chdir $TFMDESTDIR) {
	my $err="$!";
	unlink "$TFMDESTDIR/tfm$$.tmp";
	die "$progname: chdir $TFMDESTDIR failed: $err\n";
}

unless (chmod +(stat cwd())[2] & 0644, "tfm$$.tmp") {
	my $err="$!";
	unlink "tfm$$.tmp";
	die "$progname: chmod tfm$$.tmp failed: $err\n";
}

if (! -r $TFMNAME) {
	unless(move("tfm$$.tmp", $TFMNAME)) {
		my $err="$!";
		unlink "tfm$$.tmp", $TFMNAME;
		die "$progname: move tfm$$.tmp $TFMNAME failed: $err\n";
	}
	-r $TFMNAME
		or die "$progname: couldn't install $TFMNAME and don't know why not!\n";
}

# OK, success with the TFM.
mktex_upd($TFMDESTDIR, $TFMNAME);
print SAVEOUT "$TFMDESTDIR/$TFMNAME\n";
print "$progname: $TFMDESTDIR/$TFMNAME: successfully generated.\n";

# Since we probably made a GF(->PK) file, too, may as well install it if
# it's needed.  We exit with a successful exit status if anything goes
# wrong from here onwards, as we *have* successfully created the TFM file.

chdir $TEMPDIR or exit 0;
if (-r $GFNAME and ! -f $PKDEST) {
	if (system("gftopk ./$GFNAME $PKNAME </dev/null") >> 8 != 0) {
		warn "$progname: gftopk ./$GFNAME $PKNAME failed: $!\n";
		exit 0;
	}
	eval { mktex_dir $PKDESTDIR; }; exit 0 if $@;

	push @cleanfiles, "$PKDESTDIR/pk$$.tmp";
	unless (move($PKNAME, "$PKDESTDIR/pk$$.tmp")) {
		warn "$progname: move of pk file to destination directory failed: $!\n";
		unlink "$PKDESTDIR/pk$$.tmp";
		exit 0;
	}
	unless (chdir $PKDESTDIR) {
		warn "$progname: chdir $PKDESTDIR failed: $!\n";
		unlink "$PKDESTDIR/pk$$.tmp";
		exit 0;
	}
	if (-f $PKNAME) {
		unlink "pk$$.tmp";
	}
	else {
		unless (chmod +(stat cwd())[2] & 0644, "pk$$.tmp") {
			warn "$progname: chmod pk$$.tmp failed: $!\n";
			unlink "tfm$$.tmp";
			exit 0;
		}
		unless(move("pk$$.tmp", $PKNAME)) {
			warn "$progname: move tfm$$.tmp $TFMNAME failed: $!\n";
			unlink "pk$$.tmp", $PKNAME;
			exit 0;
		}
		unless (-r $PKNAME) {
			warn "$progname: couldn't install $PKNAME and don't know why not!\n";
			unlink "pk$$.tmp", $PKNAME;
			exit 0;
		}
		mktex_upd($PKDESTDIR, $PKNAME);
	}
}

exit 0;
