#! /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@dbs.uni-hannover.de, kb@mail.tug.org, and infovore@xs4all.nl.
#   Public domain.
#   version='Id: mktextfm,v 1.26 2002/11/12 17:56:21 olaf Exp '
# 
# 
# Perl version:
# $Id: mktextfm,v 1.12 2003/03/05 15:22:52 jdg Exp $
# Copyright 1999, 2003 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 $KPSE_DOT);
use TeX::Kpsewhich;
use Cwd;

$progname=basename($0);
$version=strip_quotes(<<'EOV');
:   Perl version: $Id: mktextfm,v 1.12 2003/03/05 15:22:52 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 {
    # determine the progname of metafont to use; prefer mf-nowin.
    if (system("(mf-nowin --version) >/dev/null 2>&1") >> 8 == 0) {
	$MF="mf-nowin -progname=mf";
    } else {
	$MF="mf";
    }

    $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;
