#!/usr/local/bin/perl # $Id$ =head1 NAME Fontmap2Symlink - Create Symlinks for Font::AFM from Ghostscript Fontmap file =head1 SYNOPSYS Fontmap2Symlink [-h] [-v] [-n] [-f filename] [-d dir] =head1 DESCRIPTION This perl script creates symlinks so that your AFM files that come with Ghostscript will work with the Font::AFM perl module. =over 4 =item B<-h> displays a help message =item B<-v> specifies verbose mode =item B<-n> just read the file and tell what symlinks would be created =item B<-f file> the fontmap file (defaults to "Fontmap") =item B<-d dir> the directory the symlinks are created in (defaults to ".") =back =pod OSNAMES any =pod SCRIPT CATEGORIES Utilities =head1 COPYRIGHT Copyright 1998 Mark A. Hershberger. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself =cut use strict; #use diagnostics; use Getopt::Std; my $VERSION = 1.0; my %opt; # where the options for Getopt are stored. my $dir = "."; # directory to make the symlinks in. my $fontmap = "Fontmap"; # Location of the Fontmap file my $verbose; # Specify if this is verbose or not my %fontfile; # Hash of names to files my %fonts; # Hash of fonts to fonts my $nosymlink; # Specify if we don't actually create the # symlinks my $usage = q{usage: Fontmap2Symlink [-h] [-v] [-f filename] [-d dir] where -h displays this message -v specifies verbose mode -n run without actually makeing the symlinks -f specifies a the filename to use for Fontmap (defauts to "Fontmap") -d specifies the directory to make the symlinks in (defauts to ".") }; getopts("hvnf:d:", \%opt); die $usage if defined $opt{h}; die "No symlink support!\n" unless (eval {symlink("","");}, $@ eq ''); $dir = $opt{d} if defined $opt{d}; $fontmap = $opt{f} if defined $opt{f}; $verbose = $opt{v} if defined $opt{v}; $nosymlink = $opt{n} if defined $opt{n}; chdir $dir || die "Couldn't chdir to $dir: $!\n"; open(FONTMAP, $fontmap) || die "Can't open $fontmap: $!\n"; while () { chomp; if (m:/([^\s]+)\s+\(([^\.]+)\.pfb\)\s*;:) { $fontfile{"$1.afm"} = "$2.afm"; print "$1.afm-> $2.afm\n" if $verbose; } if (m:/([^\s]+)\s+/([^\s]+)\s*;:) { $fonts{"$1.afm"} = "$2.afm"; print "$1.afm => $2.afm (alias)\n" if $verbose; } } close(FONTMAP); for (keys %fontfile) { if (!$nosymlink) { symlink $fontfile{$_}, "$_" || warn "Symlink failed: $!\n"; } print "Created symlink pointing $_ to $fontfile{$_}\n" if $verbose; } for (keys %fonts) { if (!$nosymlink) { symlink "$fonts{$_}", "$_" || warn "Symlink failed: $!\n"; } print "Created symlink pointing $_ to $fonts{$_}\n" if $verbose; }