From a07d7bdd58c2ae46f66d4355400ee82bba61ac5a Mon Sep 17 00:00:00 2001 From: Reinhard Kotucha Date: Mon, 10 Dec 2007 20:49:36 +0000 Subject: updmap.pl: a temporary version of updmap.pl which avoids modules. newgetopt.pl: a module used by updmap.pl which can't be avoided ATM. Both files will be replaced/removed ASAP. git-svn-id: svn://tug.org/texlive/trunk@5751 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf/scripts/tetex/updmap.pl | 182 ++++++++++++++++-------- Master/tlpkg/lib/Perl5_lib-TL_inst/newgetopt.pl | 75 ++++++++++ 2 files changed, 196 insertions(+), 61 deletions(-) create mode 100644 Master/tlpkg/lib/Perl5_lib-TL_inst/newgetopt.pl diff --git a/Master/texmf/scripts/tetex/updmap.pl b/Master/texmf/scripts/tetex/updmap.pl index e3b9e9b0139..304d83956ba 100644 --- a/Master/texmf/scripts/tetex/updmap.pl +++ b/Master/texmf/scripts/tetex/updmap.pl @@ -1,3 +1,4 @@ +#!/usr/bin/env perl ############################################################################### # updmap: utility to maintain map files for outline fonts. # @@ -16,13 +17,10 @@ # --outputdir directory specify output directory (for all files) # --quiet reduce verbosity ############################################################################### +#$^W=1; require "newgetopt.pl"; -use Cwd; -use Strict; -use File::Copy; -use File::Compare; -use File::Path; +use strict; # my $IsWin32 = ($^O =~ /MSWin32/i); @@ -31,6 +29,7 @@ use File::Path; # use Win32::API; # } + my $progname; my $cnfFile; my $cnfFileShort; @@ -222,23 +221,6 @@ my @fileADOBE = ( 's/\buzdr.pfb\b/zd______.pfb/x' ); -my %base14RemovePSName = ( - '/^[^\s]*\sCourier\s/' => 's/\s[^\s]*//', - '/^[^\s]*\sCourier-Bold\s/' => 's/\s[^\s]*//', - '/^[^\s]*\sCourier-Oblique\s/' => 's/\s[^\s]*//', - '/^[^\s]*\sCourier-BoldOblique\s/' => 's/\s[^\s]*//', - '/^[^\s]*\sHelvetica\s/' => 's/\s[^\s]*//', - '/^[^\s]*\sHelvetica-Bold\s/' => 's/\s[^\s]*//', - '/^[^\s]*\sHelvetica-Oblique\s/' => 's/\s[^\s]*//', - '/^[^\s]*\sHelvetica-BoldOblique\s/' => 's/\s[^\s]*//', - '/^[^\s]*\sSymbol\s/' => 's/\s[^\s]*//', - '/^[^\s]*\sTimes-Roman\s/' => 's/\s[^\s]*//', - '/^[^\s]*\sTimes-Bold\s/' => 's/\s[^\s]*//', - '/^[^\s]*\sTimes-Italic\s/' => 's/\s[^\s]*//', - '/^[^\s]*\sTimes-BoldItalic\s/' => 's/\s[^\s]*//', - '/^[^\s]*\sZapfDingbats\s/' => 's/\s[^\s]*//' -); - &main; exit 0; @@ -271,6 +253,82 @@ exit 0; # } # } + +############################################################################### +# mkdirhier(directory) +# create a directory and parent directories as needed +############################################################################### +sub mkdirhier { + my $tree=shift; + my $mode=shift; + my $subdir; + + return if (-d $tree); + my @dirs=split /\//, $tree; + foreach my $dir (@dirs) { + $subdir .= ("$dir" . "/"); + unless (-d $subdir) { + if (defined $mode) { + mkdir ("$subdir", $mode) or die "Can't mkdir '$subdir': $!.\n"; + } else { + mkdir "$subdir" or die "Can't mkdir '$subdir': $!.\n"; + } + } + } +} + +############################################################################### +# equalize_file(filename[, comment_char]) +# read a file and return its processed content as a string. +# look into the source code for more details. +############################################################################### +sub equalize_file { + my $file=shift; + my $comment=shift; + my @temp; + + open IN, "$file"; + my @lines=(); + close IN; + chomp(@lines); + + for (@lines) { + s/\s*${comment}.*// if (defined $comment); # remove comments + next if /^\s*$/; # remove empty lines + s/\s+/ /g; # replace multiple whitespace chars by a single one + push @temp, $_; + } + return join('X', sort(@temp)); +} + + +############################################################################### +# files_are_different(file_A, file_B[, comment_char]) +# compare two equalized files. +############################################################################### +sub files_are_different { + my $file_A=shift; + my $file_B=shift; + my $comment=shift; + my $retval=0; + + my $A=equalize_file("$file_A", $comment); + my $B=equalize_file("$file_B", $comment); + $retval=1 unless ($A eq $B); + return $retval; +} + + +############################################################################### +# files_are_equal(file_A, file_B[, comment_char]) +# compare two equalized files. Same as files_are_different() with +# return value inverted. +############################################################################### +sub files_are_equal { + return (&files_are_different (@_))? 0:1; +} + + ############################################################################### # getLines() # return the lines in $filename @@ -371,7 +429,7 @@ sub help { print " --edit edit updmap.cfg file\n"; print " --help show this message\n"; print " --showoptions item show alternatives for options\n"; - print " --setoption option value set option where option is one\n"; + print " --setoption option=value set option where option is one\n"; print " of dvipsPreferOutline, LW35, dvipsDownloadBase35\n"; print " or pdftexDownloadBase14\n"; print " --enable maptype=mapfile add or enable a Map or MixedMap\n"; @@ -412,7 +470,7 @@ sub cfgval { else { $value = 0; } - break; + last; } } print "$variable => " . ($value ? "true\n" : "false\n"); @@ -454,7 +512,8 @@ sub setupSymlinks { ############################################################################### # transLW35(args ...) # transform fontname and filenames according to transformation specified -# by mode +# by mode. Possible values: +# URW|URWkb|ADOBE|ADOBEkb ############################################################################### sub transLW35 { my ($name) = @_; @@ -478,14 +537,6 @@ sub transLW35 { return @lines; } -sub base14RemovePSName { - my @lines = @_; - foreach my $r (keys %base14RemovePSName) { - map { eval $base14RemovePSName{$r} if (eval($r)) ; } @lines; - } - return @lines; -} - ############################################################################### # locateWeb2c (file ...) # apply kpsewhich with format 'web2c files' @@ -513,9 +564,11 @@ sub locateWeb2c { sub locateMap { my @files = @_; + chomp @files; return @files if ($#files < 0); @files = `kpsewhich --format=map @files`; + chomp @files; if (wantarray) { return @files; } @@ -703,13 +756,17 @@ sub setupOutputDir { if (!$od) { my $rel = "fonts/map/$driver/updmap"; - + my $tf; # Try TEXMFVAR tree. Use it if variable is set and $rel can # be written. Copy config file if it does not exist there. - my $tf = `kpsewhich -expand-var="\$TEXMFVAR"`; + if ($^O=~/^MSWin(32|64)$/) { + $tf = `kpsewhich --expand-var="\$TEXMFVAR"`; + } else { + $tf = `kpsewhich --expand-var="\\\$TEXMFVAR"`; + } chomp($tf); if ($tf) { - mkpath("$tf/$rel"); + &mkdirhier("$tf/$rel"); # system("$TEXMFMAIN/web2c/mktexdir \"$tf/$rel\""); if (! -d "$tf/$rel" || ! -w "$tf/$rel") { # forget about TEXMFVAR tree... @@ -734,7 +791,7 @@ sub setupOutputDir { # No need to call mktexdir ! # system("$TEXMFMAIN/bin/win32/mktexdir \"$od\""); - mkpath($od); + &mkdirhier($od); &abort("output directory `$od' does not exist\n") if (! -d $od); &abort("output directory `$od' is not writable\n") if (! -w $od); print "using $driver output directory `$od'\n"; @@ -760,7 +817,7 @@ sub setupCfgFile { my $tf = `kpsewhich -expand-var="\$TEXMFVAR"`; chomp($tf); if ($tf && ! -f "$tf/web2c/$cnfFileShort") { - mkpath("$tf/web2c") if (! -d "$tf/web2c"); + &mkdirhier("$tf/web2c") if (! -d "$tf/web2c"); # &start_redirection("nul"); # system("mktexdir $tf/web2c"); # &stop_redirection; @@ -853,11 +910,13 @@ sub normalizeLines { my @lines = @_; my %count = (); - @lines = grep { $_ !~ m/^%/ } @lines; + @lines = grep { $_ !~ m/^[*#;%]/ } @lines; map {$_ =~ s/\s+/ /gx } @lines; @lines = grep { $_ !~ m/^\s*$/x } @lines; map { $_ =~ s/\s$//x ; - $_ =~ s/\s*\"\s*/ \" /gx } @lines; + $_ =~ s/\s*\"\s*/ \" /gx; + $_ =~ s/\" ([^\"]*) \"/\"\1\"/gx; + } @lines; @lines = grep {++$count{$_} < 2 } (sort @lines); @@ -909,21 +968,22 @@ sub dvips2dvipdfm { # the main task of this script: create the output files ############################################################################### sub mkMaps { + my @lines; $mode = &cfgval("LW35"); - $mode = "URWkb" if ! $mode; + $mode = "URWkb" unless (defined $mode); $dvipsPreferOutline = &cfgval("dvipsPreferOutline"); - $dvipsPreferOutline = 1 if ! $dvipsPreferOutline; + $dvipsPreferOutline = 1 unless (defined $dvipsPreferOutline); $dvipsDownloadBase35 = &cfgval("dvipsDownloadBase35"); - $dvipsDownloadBase35 = 0 if ! $dvipsDownloadBase35; + $dvipsDownloadBase35 = 0 unless (defined $dvipsDownloadBase35); $pdftexDownloadBase14 = &cfgval("pdftexDownloadBase14"); - $pdftexDownloadBase14 = 0 if ! $pdftexDownloadBase14; + $pdftexDownloadBase14 = 0 unless (defined $pdftexDownloadBase14); $dvipdfmDownloadBase14 = &cfgval("dvipdfmDownloadBase14"); - $dvipdfmDownloadBase14 = 0 if ! $dvipdfmDownloadBase14; + $dvipdfmDownloadBase14 = 0 unless (defined $dvipdfmDownloadBase14); if (! $quiet) { print "\ @@ -1006,24 +1066,12 @@ updmap is creating new map files using the following configuration:\ push @tmp7, &getLines(@tmp2); @tmp7 = grep { $_ !~ m/(^%|PaintType)/ } @tmp7; - # remove PS-Fontname from ExtendFont / SlantFont lines (works around a - # pdftex bug) my @pdftex_ndl14_map = @tmp3; - map { - if (m/\".*\b(Slant|Extend)Font\b.*\"/x) { - $_ =~ s/\s[^\s]*//; - } - } @pdftex_ndl14_map; @pdftex_ndl14_map = &normalizeLines(@pdftex_ndl14_map); &writeLines(">$pdftexoutputdir/pdftex_ndl14.map", @pdftex_ndl14_map); my @pdftex_dl14_map = @tmp7; - map { - if (m/\".*\b(Slant|Extend)Font\b.*\"/x) { - $_ =~ s/\s[^\s]*//; - } - } @pdftex_dl14_map; - @pdftex_dl14_map = &normalizeLines(&base14RemovePSName(@pdftex_dl14_map)); + @pdftex_dl14_map = &normalizeLines(@pdftex_dl14_map); &writeLines(">$pdftexoutputdir/pdftex_dl14.map", @pdftex_dl14_map); my @dvipdfm_dl14_map = @tmp7; @@ -1054,8 +1102,12 @@ updmap is creating new map files using the following configuration:\ "$dvipdfmoutputdir/dvipdfm_dl14.map", "$dvipdfmoutputdir/dvipdfm_ndl14.map", "$dvipsoutputdir/ps2pk.map") { - $f =~ s@/@\\@g; $f = "\"$f\"" if ($f =~ m/\s/); - my @lines = `dir $f`; + if ($^O=~/^MSWin(32|64)$/) { + $f =~ s@/@\\@g; $f = "\"$f\"" if ($f =~ m/\s/); + @lines = `dir $f`; + } else { + @lines = `ls -l $f`; + } chomp @lines; my $rx = "(^ |dvipdfm.map|dvipdfm_dl14.map|dvipdfm_ndl14.map|pdftex.map|pdftex_dl14.map|pdftex_ndl14.map|ps2pk.map|psfonts.map|psfonts_pk.map|psfonts_t1.map|builtin35.map|download35.map)"; @lines = grep /$rx/, @lines; @@ -1121,7 +1173,7 @@ sub main { } } - if ($cmd && ! compare($bakFile, $cnfFile)) { + if ($cmd and &files_are_equal($bakFile, $cnfFile)) { print "$cnfFile unchanged. Map files not recreated.\n" unless ($quiet); } else { @@ -1134,3 +1186,11 @@ sub main { } } +__END__ + +### Local Variables: +### perl-indent-level: 2 +### tab-width: 2 +### indent-tabs-mode: nil +### End: +# vim:set tabstop=2 expandtab: # diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/newgetopt.pl b/Master/tlpkg/lib/Perl5_lib-TL_inst/newgetopt.pl new file mode 100644 index 00000000000..95eef220fe7 --- /dev/null +++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/newgetopt.pl @@ -0,0 +1,75 @@ +# $Id: newgetopt.pl,v 1.18 2001-09-21 15:34:59+02 jv Exp $ + +# This library is no longer being maintained, and is included for backward +# compatibility with Perl 4 programs which may require it. +# It is now just a wrapper around the Getopt::Long module. +# +# In particular, this should not be used as an example of modern Perl +# programming techniques. +# +# Suggested alternative: Getopt::Long + +{ package newgetopt; + + # Values for $order. See GNU getopt.c for details. + $REQUIRE_ORDER = 0; + $PERMUTE = 1; + $RETURN_IN_ORDER = 2; + + # Handle POSIX compliancy. + if ( defined $ENV{"POSIXLY_CORRECT"} ) { + $autoabbrev = 0; # no automatic abbrev of options (???) + $getopt_compat = 0; # disallow '+' to start options + $option_start = "(--|-)"; + $order = $REQUIRE_ORDER; + $bundling = 0; + $passthrough = 0; + } + else { + $autoabbrev = 1; # automatic abbrev of options + $getopt_compat = 1; # allow '+' to start options + $option_start = "(--|-|\\+)"; + $order = $PERMUTE; + $bundling = 0; + $passthrough = 0; + } + + # Other configurable settings. + $debug = 0; # for debugging + $ignorecase = 1; # ignore case when matching options + $argv_end = "--"; # don't change this! +} + +use Getopt::Long; + +################ Subroutines ################ + +sub NGetOpt { + + $Getopt::Long::debug = $newgetopt::debug + if defined $newgetopt::debug; + $Getopt::Long::autoabbrev = $newgetopt::autoabbrev + if defined $newgetopt::autoabbrev; + $Getopt::Long::getopt_compat = $newgetopt::getopt_compat + if defined $newgetopt::getopt_compat; + $Getopt::Long::option_start = $newgetopt::option_start + if defined $newgetopt::option_start; + $Getopt::Long::order = $newgetopt::order + if defined $newgetopt::order; + $Getopt::Long::bundling = $newgetopt::bundling + if defined $newgetopt::bundling; + $Getopt::Long::ignorecase = $newgetopt::ignorecase + if defined $newgetopt::ignorecase; + $Getopt::Long::ignorecase = $newgetopt::ignorecase + if defined $newgetopt::ignorecase; + $Getopt::Long::passthrough = $newgetopt::passthrough + if defined $newgetopt::passthrough; + + &GetOptions; +} + +################ Package return ################ + +1; + +################ End of newgetopt.pl ################ -- cgit v1.2.3