#!/usr/bin/perl 
#
# Copyright (C) 1997-1998 Federico Di Gregorio.
#
# This program is part of the Definitive Type Manager package.
#
# 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, 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 MERCHANTIBILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#

use strict;

# Some program infos and other global stuff
my $prog_name = 'dtm-type1';
my $prog_version = '0.5';
my $outlines_path = '/usr/share/fonts/type1/outlines';
my $metrics_path = '/usr/share/fonts/type1/metrics';

# Packages used
use Getopt::Long;
use DTM::Utils;
use DTM::Type1Utils;
use DTM::Snippet;

# Display the licence
sub Licence {
    print <<EOT;

  $prog_name (dtm) $prog_version
  Copyright (C) 1997-1998 Federico Di Gregorio. 

  This program is part of the Definitive Type Manager.

  This 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, or (at your option) any later
  version.

  This 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 with
  your Debian GNU/Linux system, in /usr/doc/copyright/GPL, or with the
  dfont source package as the file COPYING.  If not, write to the Free
  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 

EOT
    exit;
}


# Display a banner
sub Banner {
    print <<EOT;
$prog_name $prog_version
This program is part of the Definitive Type Manager.
Type $prog_name --help for help about managing fonts.
Type $prog_name --licence for copyright licence and lack of warranty.

EOT
    exit;
}


# Display usage help
sub Usage {
    print <<EOT;
Usage: 
  $prog_name actions options <font files>

Where the actions are:
  -I, --info             guess some information about the fonts

And the options are:
  -p, --path=<path>      use <path> and not the real font path
  -a, --afm              checks and prints AFM information
  -P, --afmpath=<path>   use <path> and not the real afm path
  -s, --stdpaths         uses the hardcoded standard paths
  -l, --alias            information about an alias to the given font

And: 
  -h, --help             display this help message
      --licence          display the licence
      --version          display a banner

If the --info action is given, it tries to extract as much information
as possible from the given files. The information is formatted
to be used as a catalog snippet by the font installer `dtm'. In that case
the missing keys are printed with a `MISSING' value and their true
value should be extrapolated by the user before the install.
If the --alias switch is given, two snippets are generated for every
font: the first refers to the real font, the second is a template that
can be used to build an alias to that font.
EOT
    exit;
}


# Sets some global variables to hold parameters
my ($opt_info, $opt_path, $opt_afmpath, $opt_stdpaths);
my ($opt_alias, $opt_afm, $opt_licence, $opt_help, $opt_version);

# some other globals
my @fonts;

# Process parameters
sub GetParams {
    my $ret = GetOptions("info|I", \$opt_info,
			 "afm|a", \$opt_afm,
			 "path|p=s", \$opt_path,
			 "afmpath|P=s", \$opt_afmpath,
			 "stdpaths|s", \$opt_stdpaths,
			 "alias|l", \$opt_alias,
			 "licence", \$opt_licence,
			 "help|h", \$opt_help,
			 "version", \$opt_version);

    Banner() if $opt_version;
    Usage() if ($opt_help);
    Licence() if ($opt_licence);
    
    # if more than one action is requested, there is an error,
    # but at least an action is required
    if (!$opt_info) {
	dtm_error("an action option (e.g., info) is required");
    }

    # here we try to get the right parameters from the command line
    if (@ARGV == 0) {
	dtm_error("One Or More Font Files Are required");
    }

    # uses std paths
    if ($opt_stdpaths) {
	$opt_path = $outlines_path;
	$opt_afmpath = $metrics_path;
    }

    # if a font file is required, tries to locate it
    foreach my $i (@ARGV) {
	@fonts = (@fonts, glob($i));
    }
    for my $i (0..$#fonts) {
	-r $fonts[$i] or do {
	    dtm_warning("'$fonts[$i]' doesn't exist or is not readable; " .
		    "skipping");
	    undef $fonts[$i];
	}
    }
    # kills empty entries
    @fonts = (@fonts);
}


# Process command line arguments and creates a new font catalog
Getopt::Long::config("bundling");
GetParams();

foreach my $fontfile (sort @fonts) {

    next if !$fontfile;

    #extracts the basename and the absolute path to the font
    my ($path, $file) = abs_path_file($fontfile);

    # gather infos
    my $info = build_type1snippet($path, $file);
    $info->set_attr('FontPath', $opt_path) if $opt_path;

    # look for afm file, note that it should have the name
    # equal to the PSName of the font or it won't be found by
    # programs like enscript...
    if ($opt_afm) {
	my $afm_file = $info->get_attr('Name', 'psspecific') . '.afm';
	if (-f $afm_file) {
	    ($path, $file) = abs_path_file($afm_file);
	    $info->set_attrs(undef, 
			     'MetricsFile', $file,
			     'MetricsPath', 
			         $opt_afmpath ? $opt_afmpath : $path,
			     'Metrics', 'YES');
	}
	else {
	    dtm_warning("metrics file `$afm_file' not found");
	}
    }

    if ($opt_alias) {
	my $alias =  $info->new();
	$alias->del_attr('FontFile');
	$alias->del_attr('FontPath');
	$alias->set_attrs(undef,
			  'Alias', $info->get_attr('ID'),
			  'ID', 'alias_of_' . $info->get_attr('ID'),
			  'Typeface', '',
			  'Name', '',
			  'Foundry', '');
	$alias->set_attr('Name', '', 'psspecific');
	$alias->set_attr('Name', '', 'x11specific');
	print $alias->dump_to_string() . "\n";
    }
    
    # and print it
    print $info->dump_to_string() . "\n";
}