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

2 files changed, 196 insertions, 61 deletions

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=(<IN>);
+  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 ################