make multi-updmap independent from TeXLive perl modules,

make handling of config file for changes better


git-svn-id: svn://tug.org/texlive/trunk@23820 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 177 insertions, 34 deletions

diff --git a/Master/tlpkg/dev/multi-updmap.pl b/Master/tlpkg/dev/multi-updmap.pl
index 8723c91b455..e97159b7e40 100644
--- a/Master/tlpkg/dev/multi-updmap.pl
+++ b/Master/tlpkg/dev/multi-updmap.pl
@@ -24,33 +24,24 @@
 #   any fonts. The updmap.cfg has to me moved into TEXMFDIST/web2c/
 #   and tlmgr needs to update this file from the installed fonts.
 
-my ($TEXMFROOT, $TEXMFMAIN, $TEXMFVAR, $TEXMFCONFIG);
-
-BEGIN {
-  $^W=1;
-  if ($] < 5.008008) {
-    die "$0: Perl version 5.8.8 or newer required.  Aborting.\n";
-  }
-  $TEXMFROOT = `kpsewhich -var-value=TEXMFROOT`;
-  if ($?) {
-    print STDERR "updmap: Cannot find TEXMFROOT, aborting!\n";
-    exit 1;
-  }
-  chomp($TEXMFROOT);
-  chomp($TEXMFMAIN =`kpsewhich --var-value=TEXMFMAIN`);
-  chomp($TEXMFVAR = `kpsewhich -var-value=TEXMFVAR`);
-  chomp($TEXMFCONFIG = `kpsewhich -var-value=TEXMFCONFIG`);
-  unshift (@INC, "$TEXMFROOT/tlpkg");
-}
+$^W=1;
+use strict;
 
 my $version = '$Id$';
-
-use strict;
-use TeXLive::TLUtils qw(mkdirhier mktexupd win32 log);
 use Getopt::Long qw(:config no_autoabbrev ignore_case_always);
-use Pod::Usage;
 
-my $prg = TeXLive::TLUtils::basename($0);
+my ($TEXMFROOT, $TEXMFMAIN, $TEXMFVAR, $TEXMFCONFIG);
+$TEXMFROOT = `kpsewhich -var-value=TEXMFROOT`;
+if ($?) {
+  print STDERR "updmap: Cannot find TEXMFROOT, aborting!\n";
+  exit 1;
+}
+chomp($TEXMFROOT);
+chomp($TEXMFMAIN =`kpsewhich --var-value=TEXMFMAIN`);
+chomp($TEXMFVAR = `kpsewhich -var-value=TEXMFVAR`);
+chomp($TEXMFCONFIG = `kpsewhich -var-value=TEXMFCONFIG`);
+
+my $prg = basename($0);
 
 my %opts = ( quiet => 0, nohash => 0, nomkmap => 0 );
 my $alldata;
@@ -164,7 +155,7 @@ sub main {
       my $dn = "$TEXMFCONFIG/web2c";
       $changes_config_file = "$dn/updmap.cfg";
       # don't use used_files here, it goes into an infinite loop!
-      unshift @final, $changes_config_file;
+      #unshift @final, $changes_config_file;
     }
     @{$opts{'cnffile'}}  = @final;
   }
@@ -172,8 +163,8 @@ sub main {
   for my $f (@{$opts{'cnffile'}}) {
     print "  $f\n";
   }
-  read_updmap_files(@{$opts{'cnffile'}});
   $alldata->{'changes_config'} = $changes_config_file;
+  read_updmap_files(@{$opts{'cnffile'}});
 
   if ($opts{'listmaps'}) {
     for my $m (keys %{$alldata->{'maps'}}) {
@@ -210,7 +201,12 @@ sub main {
     $cmd = 'edit';
     my $editor = $ENV{'VISUAL'} || $ENV{'EDITOR'};
     $editor ||= (&win32 ? "notepad" : "vi");
-    &copyFile($changes_config_file, $bakFile);
+    if (-r $changes_config_file) {
+      &copyFile($changes_config_file, $bakFile);
+    } else {
+      touch($bakFile);
+      touch($changes_config_file);
+    }
     system($editor, $changes_config_file);
     $changed = files_are_different($bakFile, $changes_config_file);
   } elsif ($opts{'setoption'}) {
@@ -237,6 +233,14 @@ sub main {
       if !$opts{'quiet'};
   } else {
     if (!$opts{'nomkmap'}) {
+      # before we continue we have to make sure that a newly created config
+      # file is acually used. So we have to push the $changes_config_file
+      # onto the list of available files. Since it is already properly
+      # initialized and the merging is done later,  all settings should be
+      # honored
+      my @aaa = $alldata->{'order'};
+      unshift @aaa, $changes_config_file;
+      $alldata->{'order'} = [ @aaa ];
       setupOutputDir("dvips");
       setupOutputDir("pdftex");
       my @missing = read_map_files();
@@ -566,7 +570,7 @@ sub mkMaps {
 
   if (! $opts{'dry-run'}) {
     $logfile = "$TEXMFVAR/web2c/updmap.log";
-    mkdirhier "$TEXMFVAR/web2c";
+    mkdirhier("$TEXMFVAR/web2c");
     open LOG, ">$logfile"
         or die "$prg: Can't open log file \"$logfile\": $!";
     print LOG &version();
@@ -1071,7 +1075,7 @@ sub setOption {
 
   die "$prg: Unsupported option $opt." if (!defined($settings{$opt}));
   die "$0: Invalid value $val for option $opt." 
-    if (!TeXLive::TLUtils::member($val, @{$settings{$opt}}));
+    if (!member($val, @{$settings{$opt}}));
 
   # silently accept this old option name, just in case.
   return if $opt eq "dvipdfmDownloadBase14";
@@ -1105,7 +1109,7 @@ sub copyFile {
   my ($src, $dst) = @_;
   my $dir;
   ($dir=$dst)=~s/(.*)\/.*/$1/;
-  mkdirhier $dir;
+  mkdirhier($dir);
 
   $src eq $dst && return "can't copy $src to itself!\n";
 
@@ -1195,8 +1199,10 @@ sub normalizeLines {
 # we do not fill everything from the very beginning to make sure that
 # we only read what is necessary (speed!)
 #
-# initialized by read_updmap_files
+# initialized by main
 # $alldata->{'changes_config'} = the config file where changes are saved
+#
+# initialized by read_updmap_files
 # $alldata->{'order'} = [ list of updmap in decreasing priority ]
 # $alldata->{'updmap'}{$full_path_name_of_updmap}{'lines'} = \@lines
 # $alldata->{'updmap'}{$full_path_name_of_updmap}{'setting'}{$key}{'val'} = $val
@@ -1239,6 +1245,12 @@ sub read_updmap_files {
       }
     }
   }
+  # in case the changes_config is a new one read it in and initialize it here
+  my $cc = $alldata->{'changes_config'};
+  if (! -r $cc) {
+    $alldata->{'updmap'}{$cc}{'lines'} = [ ];
+  }
+  #
   $alldata->{'order'} = \@l;
   # first round determine which maps should be used and which type, as
   # different updmap.cfg files might specify different types of maps
@@ -1258,9 +1270,7 @@ sub read_updmap_file {
   my $fn = shift;
   my %data;
   if (!open(FN,"<$fn")) {
-    log("initializing empty $fn: $!");
-    $data{'lines'} = [ ];
-    return \%data;
+    die ("Cannot read $fn: $!");
   }
   # we count lines from 0 ..!!!!
   my $i = -1;
@@ -1341,7 +1351,7 @@ sub read_map_files {
     push @maps, $m;
     $alldata->{'maps'}{$m}{'status'} = 'enabled';
   }
-  @maps = TeXLive::TLUtils::sort_uniq(@maps);
+  @maps = sort_uniq(@maps);
   my @fullpath = `kpsewhich --format=map @maps`;
   chomp @fullpath;
   foreach my $map (@maps) {
@@ -1626,6 +1636,139 @@ EOF
   exit 0;
 }
 
+#############################################
+#
+# Utilities from TeXLive::TLUtils, we want to be self contained
+#
+sub win32
+{
+  if ($^O=~/^MSWin(32|64)$/i) {
+    return 1;
+  } else {
+    return 0;
+  }
+  # the following needs config.guess, which is quite bad ...
+  # return (&platform eq "win32")? 1:0;
+}
+
+sub mkdirhier {
+  my ($tree,$mode) = @_;
+
+  return if (-d "$tree");
+  my $subdir = "";
+  # win32 is special as usual: we need to separate //servername/ part
+  # from the UNC path, since (! -d //servername/) tests true
+  $subdir = $& if ( win32() && ($tree =~ s!^//[^/]+/!!) );
+
+  my @dirs = split (/\//, $tree);
+  for my $dir (@dirs) {
+    $subdir .= "$dir/";
+    if (! -d $subdir) {
+      if (defined $mode) {
+        mkdir ($subdir, $mode)
+        || die "$0: mkdir($subdir,$mode) failed, goodbye: $!\n";
+      } else {
+        mkdir ($subdir) || die "$0: mkdir($subdir) failed, goodbye: $!\n";
+      }
+    }
+  }
+}
+
+sub mktexupd {
+  my %files;
+  my $mustexist=0;
+
+  my $hash={
+    "add" => sub {     
+      foreach my $file (@_) {
+        $file =~ s|\\|/|g;
+        $files{$file}=1;
+      }
+    },
+    # "reset" => sub { 
+    #    %files=();
+    # },
+    "mustexist" => sub {
+      $mustexist=shift;
+    },
+   "exec" => sub {
+      # check whether files exist
+      if ($mustexist) {
+        foreach my $file (keys %files) {
+          die "File \"$file\" doesn't exist.\n" if (! -f $file);
+        }
+      }
+      my $delim= (&win32)? ';' : ':';
+      my $TEXMFDBS;
+      chomp($TEXMFDBS=`kpsewhich --show-path="ls-R"`);
+
+      my @texmfdbs=split ($delim, "$TEXMFDBS");
+      my %dbs;
+     
+      foreach my $path (keys %files) {
+        foreach my $db (@texmfdbs) {
+          $db=substr($db, -1) if ($db=~m|/$|); # strip leading /
+          if (substr($path, 0, length("$db/")) eq "$db/") {
+            # we appended a / because otherwise "texmf" is recognized as a
+            # substring of "texmf-dist".
+            my $path='./' . substr($path, length("$db/"));
+            my ($dir, $file);
+            $_=$path;
+            ($dir, $file) = m|(.*)/(.*)|;
+            $dbs{$db}{$dir}{$file}=1;
+          }
+        }
+      }
+      foreach my $db (keys %dbs) {
+        if (! -f "$db" || ! -w "$db/ls-R") {
+          &mkdirhier ($db);
+        }
+        open LSR, ">>$db/ls-R";
+        foreach my $dir (keys %{$dbs{$db}}) {
+          print LSR "\n$dir:\n";
+          foreach my $file (keys %{$dbs{$db}{$dir}}) {
+            print LSR "$file\n";
+          }
+        }
+        close LSR;
+      }
+    }
+  };
+  return $hash;
+}
+
+sub basename {
+  my $path=shift;
+  if (win32) {
+    $path=~s!\\!/!g;
+  }
+  if ($path=~m!/!) {  # basename("foo/bar") -> "bar"
+    $path=~m!.*/(.*)!;
+    return $1;
+  } else {            # basename("ignore") -> "ignore"
+    return $path;
+  }
+}
+
+sub member {
+  my $what = shift;
+  return scalar grep($_ eq $what, @_);
+}
+
+sub sort_uniq {
+  my (@l) = @_;
+  my ($e, $f, @r);
+  $f = "";
+  @l = sort(@l);
+  foreach $e (@l) {
+    if ($e ne $f) {
+      $f = $e;
+      push @r, $e;
+    }
+  }
+  return @r;
+}
+
 ### Local Variables:
 ### perl-indent-level: 2
 ### tab-width: 2