move the check-duplicate-runfiles, check-depend-consistency,

check-execute-consistency to tlmgr
check-duplicate-runfiles   ->  tlmgr check runfiles
check-depend-consistency   ->  tlmgr check depends
check-execute-consistency  ->  tlmgr check executes


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

1 files changed, 323 insertions, 25 deletions

diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl
index 3707b6b2acd..f5c0e190c49 100755
--- a/Master/texmf/scripts/texlive/tlmgr.pl
+++ b/Master/texmf/scripts/texlive/tlmgr.pl
@@ -2458,6 +2458,20 @@ sub action_recreate_tlpdb {
 
 #  CHECK
 #
+sub init_tltree {
+  my $svn = shift;
+  my $Master = $localtlpdb->root;
+  my $tltree = TeXLive::TLTREE->new ("svnroot" => $Master);
+  if ($svn) {
+    debug("Initializine TLTREE from svn\n");
+    $tltree->init_from_svn;
+  } else {
+    debug("Initializine TLTREE from find\n");
+    $tltree->init_from_files;
+  }
+  return($tltree);
+}
+
 sub action_check {
   my $svn = defined($opts{"use-svn"}) ? $opts{"use-svn"} : 0;
   my $what = shift @ARGV;
@@ -2465,12 +2479,23 @@ sub action_check {
   init_local_db();
   my $ret = 0;
   if ($what =~ m/^all/i) {
-    $ret ||= check_files($svn);
-    $ret ||= check_collections($svn);
+    my $tltree = init_tltree($svn);
+    $ret ||= check_files($tltree);
+    $ret ||= check_depends();
+    $ret ||= check_executes();
+    # we do NOT automatically run the runfiles check when called with "all"
   } elsif ($what =~ m/^files/i) {
-    $ret ||= check_files($svn);
+    my $tltree = init_tltree($svn);
+    $ret ||= check_files($tltree);
   } elsif ($what =~ m/^collections/i) {
-    $ret ||= check_collections($svn);
+    tlwarn("the \"collections\" check is replaced by the \"depends\" check.\n");
+    $ret ||= check_depends();
+  } elsif ($what =~ m/^depends/i) {
+    $ret ||= check_depends();
+  } elsif ($what =~ m/^runfiles/i) {
+    $ret ||= check_runfiles();
+  } elsif ($what =~ m/^executes/i) {
+    $ret ||= check_executes();
   } else {
     print "No idea how to check that: $what\n";
   }
@@ -2480,7 +2505,7 @@ sub action_check {
 # check file coverage, roughly equivalent to tlpkg/bin/check-file-coverage
 #
 sub check_files {
-  my $svn = shift;
+  my $tltree = shift;
   my $ret = 0;
   my %filetopacks;
   my $Master = $localtlpdb->root;
@@ -2554,14 +2579,6 @@ sub check_files {
     install-tl.bat$
     install-tl.bat.manifest$
   !;
-  my $tltree = TeXLive::TLTREE->new ("svnroot" => $Master);
-  if ($svn) {
-    debug("Initializine TLTREE from svn\n");
-    $tltree->init_from_svn;
-  } else {
-    debug("Initializine TLTREE from find\n");
-    $tltree->init_from_files;
-  }
   my %tltreefiles = %{$tltree->{'_allfiles'}};
   my @tlpdbfiles = keys %filetopacks;
   my @nohit;
@@ -2592,25 +2609,295 @@ sub check_files {
   return($ret);
 }
 
-# check collections
+# check runfiles
 #
-sub check_collections {
-  my @missing = ();
-  for my $p ($localtlpdb->collections()) {
-    my $col = $localtlpdb->get_package($p);
-    for my $d ($col->depends) {
-      push @missing, "$d ($p)" if (!defined($localtlpdb->get_package($d)));
+# Check there are no duplicated runtimes files
+sub check_runfiles {
+  my $Master = $localtlpdb->root;
+  # build a list of all runtime files associated to 'normal' packages
+  #
+  (my $non_normal = `ls $Master/bin`) =~ s/\n/\$|/g; # binaries
+  $non_normal .= '^0+texlive|^bin-|^collection-|^scheme-|^texlive-';
+  my @runtime_files = ();
+  foreach my $tlpn ($localtlpdb->list_packages) {
+    next if ($tlpn =~ /$non_normal/);
+    my $tlp = $localtlpdb->get_package($tlpn);
+    my @files = $tlp->runfiles;
+    if ($tlp->relocated) { for (@files) { s!^$TeXLive::TLConfig::RelocPrefix/!$TeXLive::TLConfig::RelocTree/!; } }
+    push @runtime_files, @files;
+  }
+
+  # build the duplicates list
+  #
+  my @duplicates = (""); # just to use $duplicates[-1] freely
+  my $prev = "";
+  foreach my $f (sort map { TeXLive::TLUtils::basename($_) } @runtime_files) {
+    push (@duplicates, $f) if (($f eq $prev) and not ($f eq $duplicates[-1]));
+    $prev = $f;
+  }
+  shift @duplicates; # get rid of the fake 1st value
+
+  # @duplicates = ('8r-base.map', 'aer.sty', 'lm-ec.map'); # for debugging
+
+  # check if duplicates are different files
+  #
+  foreach my $f (@duplicates) {
+    # assume tex4ht stuff is ok, and don't worry about Changes/README for now
+    # same for .xdy files
+    next if ($f =~ /(^Changes$|^README$|\.htf$|\.4hf$|\.xdy$)/);
+    # 
+    my @copies = grep (/\/$f$/, @runtime_files);
+    # map files can be duplicated as long as copies don't concern the same engine
+    if ($f =~ /\.map$/) {
+      my $need_check = 0;
+      my $prev_dir = "";
+      my @cop = @copies; # don't break the outside list
+      map { s#^texmf-dist/fonts/map/(.*?)/.*#$1# } @cop;
+      foreach my $dir (sort  @cop ) {
+        last if ($need_check = ($dir eq $prev_dir)); 
+        $prev_dir = $dir;
+      }
+      next unless $need_check;
+    }
+    # if all copies are identical, ok, else, complain
+    my $diff = 0;
+    for (my $i = 1; $i < scalar(@copies); $i++) {
+      if ($diff = system ("diff -q --strip-trailing-cr "
+          . "$Master/$copies[$i-1] $Master/$copies[$i] >/dev/null")) {
+        print "# $f\ndiff $Master/$copies[$i-1] $Master/$copies[$i]\n";
+        last;
+      }
+    }
+    print join ("\n", @copies), "\n" if ($diff and (scalar(@copies) > 2));
+  }
+}
+
+# check executes
+#
+sub check_executes {
+  my $Master = $localtlpdb->root;
+  my (%maps,%langcodes,%fmtlines);
+  for my $pkg ($localtlpdb->list_packages) {
+    for my $e ($localtlpdb->get_package($pkg)->executes) {
+      if ($e =~ m/add(Mixed)?Map\s+(.*)$/) {
+        my $foo = $2;
+        chomp($foo);
+        push @{$maps{$foo}}, $pkg;
+      } elsif ($e =~ m/AddFormat\s+(.*)$/) {
+        my $foo = $1;
+        chomp($foo);
+        push @{$fmtlines{$foo}}, $pkg;
+      } elsif ($e =~ m/AddHyphen\s+.*\s+file=(\S+)\s*$/) {
+        my $foo = $1;
+        chomp($foo);
+        push @{$langcodes{$foo}}, $pkg;
+      } else {
+        warn "$pkg: unmatched execute: $e\n";
+      }
+    }
+  }
+  my %badmaps;
+  foreach my $mf (keys %maps) {
+    my @found = $localtlpdb->find_file($mf);
+    if ($#found < 0) {
+      $badmaps{$mf} = $maps{$mf};
+    }
+    if ($#found > 0) {
+      # we want to check for multiple inclusions
+      my %mapfn;
+      foreach my $foo (@found) {
+        $foo =~ m/^(.*):(.*)$/;
+        push @{$mapfn{$2}}, $1;
+      }
+      foreach my $k (keys %mapfn) {
+        my @bla = @{$mapfn{$k}};
+        if ($#bla > 0) {
+          warn "map file $mf occurs multiple times (in pkg @bla)!\n";
+        }
+      }
+    }
+  }
+  if (keys %badmaps) {
+    print "mentioned map file not occuring in any package:\n";
+    foreach my $mf (keys %badmaps) {
+      print "\t$mf (execute in @{$badmaps{$mf}})\n";
     }
   }
-  return(0) if (!@missing);
-  print "Packages listed in collections but not present:\n";
-  for my $m (@missing) {
-    print "\t$m\n";
+  my %badhyphcodes;
+  my %problemhyphen;
+  foreach my $lc (keys %langcodes) {
+    next if ($lc eq "zerohyph.tex");
+    my @found = $localtlpdb->find_file("texmf-dist/tex/generic/hyph-utf8/loadhyph/$lc");
+    if ($#found < 0) {
+      # try again this time search all packages
+      my @found = $localtlpdb->find_file("$lc");
+      if ($#found < 0) {
+        $badhyphcodes{$lc} = $langcodes{$lc};
+      } else {
+        $problemhyphen{$lc} = [ @found ];
+      }
+    }
+  }
+  if (keys %badhyphcodes) {
+    print "mentioned hyphen loaders without file:\n";
+    foreach my $mf (keys %badhyphcodes) {
+      print "\t$mf (execute in @{$badhyphcodes{$mf}})\n";
+    }
+  }
+  # disable the echoing of problematic hyphens
+  #if (keys %problemhyphen) {
+  #  print "hyphen files with possible problematic location:\n";
+  #  foreach my $mf (keys %problemhyphen) {
+  #    print "\t$mf (@{$problemhyphen{$mf}})\n";
+  #  }
+  #}
+  #
+  # what should be checked for the executes? we could check 
+  # - the existence of the engine in bin/i386-linux or all $arch
+  # - the existence of the format name link/bat
+  # - parse the options parameter and check for the inifile
+  # - rework the format definition that we have inifile=pdflatex.ini 
+  #   isn't the * unnecessary?
+  my %missingbins;
+  my %missingengines;
+  my %missinginis;
+  for (keys %fmtlines) {
+    my %r = TeXLive::TLUtils::parse_AddFormat_line("$_");
+    if (defined($r{"error"})) {
+      die "$r{'error'}, parsing $_, package(s) @{$fmtlines{$_}}";
+    }
+    my $opt = $r{"options"};
+    my $engine = $r{"engine"};
+    my $name = $r{"name"};
+    my $mode = $r{"mode"};
+    # special case for cont-en ...
+    next if ($name eq "cont-en");
+    # we check that the name exist in bin/$arch
+    for my $a ($localtlpdb->available_architectures) {
+      my $f = "$Master/bin/$a/$name";
+      if (!check_file($a, $f)) {
+        if ($a eq "i386-cygwin") {
+          # on cygwin the following can happen: xmltex -> pdftex, but
+          # there is only pdftex.exe, so -r does not succeed
+          if (-l $f) {
+            my $ld = readlink ($f);
+            if (!check_file($a, "$Master/bin/$a/$ld")) {
+              push @{$missingbins{$_}}, "bin/$a/$name" if $mode;
+            }
+          } else {
+            push @{$missingbins{$_}}, "bin/$a/$name" if $mode;
+          }
+        } else {
+          push @{$missingbins{$_}}, "bin/$a/$name" if $mode;
+        }
+      }
+      if (!check_file($a, "$Master/bin/$a/$engine")) {
+        push @{$missingengines{$_}}, "bin/$a/$engine" if $mode;
+      }
+    }
+    # check for the existence of the .ini file
+    # by using the last word in the options value
+    my $inifile = $opt;
+    # $inifile now contains "bla bla bla *file.ini"
+    # strip initial and trailing "
+    $inifile =~ s/^"(.*)"$/$1/;
+    # remove everything before the last space
+    $inifile =~ s/^.* ([^ ]*)$/$1/;
+    # remove the optional leading *
+    $inifile =~ s/^\*//;
+    my @found = $localtlpdb->find_file("$inifile");
+    if ($#found < 0) {
+      $missinginis{$_} = "$inifile";
+    }
+  }
+  if (keys %missinginis) {
+    print "mentioned ini files that cannot be found:\n";
+    for my $i (keys %missinginis) {
+      print "\t $missinginis{$i} (execute: $i)\n";
+    }
+  }
+  if (keys %missingengines) {
+    print "mentioned engine files that cannot be found:\n";
+    for my $i (keys %missingengines) {
+      print "\t @{$missingengines{$i}}\n";
+    }
+  }
+  if (keys %missingbins) {
+    print "mentioned bin files that cannot be found:\n";
+    for my $i (keys %missingbins) {
+      print "\t @{$missingbins{$i}}\n";
+    }
+  }
+}
+
+sub check_file {
+  my ($a, $f) = @_;
+  if (-r $f) {
+    return 1;
+  } else {
+    # not -r, so check for the extensions .bat and .exe on w32 and cygwin
+    if (($a eq "win32") || ($a eq "i386-cygwin")) {
+      if (-r "$f.exe" || -r "$f.bat") {
+        return 1;
+      }
+    }
+    return 0;
   }
-  print "\n";
 }
 
+# check depends
+#
+sub check_depends {
+  my $ret = 0;
+  my $Master = $localtlpdb->root;
+  my %presentpkg;
+  for my $pkg ($localtlpdb->list_packages) {
+    $presentpkg{$pkg} = 1;
+  }
+  # list of collections.
+  my @colls = $localtlpdb->collections;
+  my @coll_deps = $localtlpdb->expand_dependencies("-no-collections",$localtlpdb,@colls);
+  my %coll_deps;
+  @coll_deps{@coll_deps} = ();  # initialize hash with keys from list
+
+  my (%wrong_dep, @no_dep);
+  for my $pkg ($localtlpdb->list_packages) {
+    # do not check any package starting with 00texlive.
+    next if $pkg =~ m/^00texlive/;
+
+    # For each package, check that it is a dependency of some collection.
+    # Whatever is left in %coll_deps after this loop will be the problem
+    if (! exists $coll_deps{$pkg}) {
+      # Except that schemes and our special .win32 packages are ok.
+      push (@no_dep, $pkg) unless $pkg =~/^scheme-|\.win32$/;
+    }
+    
+    # For each dependency, check that we have a package.
+    for my $d ($localtlpdb->get_package($pkg)->depends) {
+      next if ($d =~ m/\.ARCH$/);
+      if (!defined($presentpkg{$d})) {
+        push (@{$wrong_dep{$d}}, $pkg);
+      }
+    }
+  }
+
+  if (keys %wrong_dep) {
+    $ret++;
+    print "DEPENDS WITHOUT PACKAGES:\n";
+    for my $d (keys %wrong_dep) {
+      print "$d occurring in ", @{$wrong_dep{$d}}, "\n";
+    }
+  }
+
+  if (@no_dep) {
+    $ret++;
+    print "PACKAGES NOT IN ANY COLLECTION: @no_dep\n";
+  }
+ 
+  return($ret); 
+}
 
+ 
 
 # Subroutines galore.
 # 
@@ -3367,6 +3654,17 @@ are actually present, and lists those missing.
 Lists those packages which occur as dependencies in an installed collections,
 but are themselves not installed.  Options:
 
+=item B<executes>
+
+Check that the files referred to by C<execute> directives in the TeX
+Live Database are present.
+
+=item B<runfiles>
+
+List those filenames that are occurring more than one time in the runfiles.
+This test needs the C<diff> utility and so is not executed when C<check>
+is called without or with the C<all> argument.
+
 =back
 
 =over 4