move place and ctan2tds to libexec, since they should never be called directly in the current world

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

1 files changed, 301 insertions, 0 deletions

diff --git a/Master/tlpkg/libexec/place b/Master/tlpkg/libexec/place
new file mode 100755
index 00000000000..b977cf6b914
--- /dev/null
+++ b/Master/tlpkg/libexec/place
@@ -0,0 +1,301 @@
+#!/usr/bin/env perl
+# $Id$
+# Public domain.  Originally written by Sebastian Rahtz.
+# 
+# Process a "cooked" tree directory (probably created by ctan2tds in
+# Build/tmp.cooked), and integrate into the main texmf trees.
+# 
+# Basic usage: place PKG
+# to process ./PKG.  Best invoked from ctan2tl, not directly.
+
+BEGIN {
+  chomp ($mydir = `dirname $0`);  # we are in Master/tlpkg/bin
+  unshift (@INC, "$mydir/..");
+}
+
+use File::Basename;
+use File::Find;
+use Cwd;
+use TeXLive::TLConfig qw/$InfraLocation $DatabaseName/;
+use TeXLive::TLPSRC;
+use TeXLive::TLPOBJ;
+use TeXLive::TLPDB;
+use TeXLive::TLTREE;
+
+if ($ARGV[0] eq "-n") {
+  $chicken = 1;
+  shift;
+} else {
+  $chicken = 0;
+}
+print "place: chicken mode = $chicken\n";
+
+die "usage: $0 PKGNAME\n" unless @ARGV == 1;
+$package = $ARGV[0];
+
+$newpackage = 0;
+%dirs = ();  # dirs we make changes in
+$TMP = $ENV{"TMPDIR"} || "/tmp";
+$tmpfile = "$TMP/$>.tlplace"; # use effective uid in temp file names
+
+$cooked = getcwd();  # ctan2tl invokes us in the cooked dire
+-d "$cooked/$package" || die "$0: No such package in $cooked: $package\n";
+
+&xchdir ("$mydir/../..");
+$M = getcwd();
+
+xchdir ("$cooked/$package");
+if    (-d "texmf-dist") {$Root="texmf-dist"; }
+elsif (-d "texmf-doc")  {$Root="texmf-doc"; }
+elsif (-d "texmf")      {$Root="texmf"; }
+else  { die ("no top level texmf in " . `pwd`); }
+
+if ($Root eq 'texmf-doc') {
+  $Type = 'Documentation';
+} elsif ($Root eq 'texmf-dist') { 
+  $Type = 'Package'; 
+} elsif ($Root eq 'texmf') { 
+  # can't handle binary stuff yet, but can do some hyphenations.
+  $Type = 'TLCore'; 
+} else {
+  die "cannot handle Root=$Root";
+}
+
+die "top-level README in $Root, that can't be right" if -e "$Root/README";
+
+# initialize TLPDB
+my $tlpdb = new TeXLive::TLPDB ('root' => $M);
+# create TLTREE from stuff in cooked/$pkg
+my $tltree = TeXLive::TLTREE->new ('svnroot' => "$cooked/$package");
+$tltree->init_from_files;
+
+# get package from TLPDB;
+my $tlpold = $tlpdb->get_package ($package);
+if (defined($tlpold)) {
+  foreach ($tlpold->all_files) {
+    $Old{$_} = 1;
+  }
+} else {
+  $newpackage = 1;
+}
+
+# create new tlpsrc and tlpobj
+my $tlpsrc = TeXLive::TLPSRC;
+my $tlpsrcfile = "$M/tlpkg/tlpsrc/$package.tlpsrc";
+if (! -r $tlpsrcfile) {
+  $tlpsrc->name($package);
+  $tlpsrc->category($Type);
+  if (!$chicken) {
+    local *TLPSRC;
+    $TLPSRC = ">$tlpsrcfile";
+    open (TLPSRC) || die "open($TLPSRC) failed: $!";
+    $tlpsrc->writeout(\*TLPSRC);
+    close TLPSRC;
+  }
+} else {
+  $tlpsrc->from_file($tlpsrcfile);
+}
+
+# make the new tlpobj.
+my $tlpnew = $tlpsrc->make_tlpobj($tltree, $M);
+
+# we took over the comparison of files from the ctan2tl script since
+# we are here in perl world, which makes it easier ...
+print "\n\f ";
+if (!defined($tlpold)) {
+  print "place: $package not present in $M/$InfraLocation/$DatabaseName\n\n";
+} else {
+  print "new vs. present $package (present is indented)\n";
+  my @oldfiles = $tlpold->all_files;
+  `rm -f $tmpfile.old`;
+  foreach (sort @oldfiles) {
+    `echo $_ >>$tmpfile.old`;
+  }
+  my @newfiles = $tlpnew->all_files;
+  `rm -f $tmpfile.new`;
+  foreach (sort @newfiles) {
+    `echo $_ >>$tmpfile.new`;
+  }
+  print `comm -3 $tmpfile.new $tmpfile.old`;
+  my @difffiles = `comm -12 $tmpfile.new $tmpfile.old`;
+  chomp (@difffiles);
+  my $sum = 0;
+  my $identical = 0;
+  #
+  my $diff_file = "$tmpfile.diff";
+  unlink ($diff_file);
+  my $diff_cmd = "diff --text --strip-trailing-cr --ignore-all-space -U 0 -s";
+  #
+  for my $f (@difffiles) {
+    my $master_file = "$M/$f";
+    my $cooked_file = "$cooked/$package/$f";
+    # diff has no options for handling Mac line endings; the above
+    # don't suffice.  So use our own script for the initial comparison.
+    if (system ("cmp-textfiles '$master_file' '$cooked_file'") == 0) {
+      $identical++;
+    } else {
+      my @diff_out = `$diff_cmd $master_file $cooked_file | tee -a $diff_file`;
+      $sum += $#diff_out - 2; # zero-based, so first line doesn't count.
+                              # subtract another two lines for the heading
+                              # and at least one hunk marker.
+    }
+  }
+  my $nrcommfiles = @difffiles;
+  #
+  my $changed = $nrcommfiles - $identical;
+  print "$nrcommfiles common files, $changed changed, ~$sum lines different ($diff_file)\n\n\f\n";
+  #`rm -f $tmpfile.*`
+}
+
+&xchdir ("$cooked/$package");
+
+print "place: checking for case-insensitive clashes\n";
+print `find . '(' -name .svn ')' -prune -o -print | sort | uniq -i -d`;
+print "\n";
+
+find (\&files, ".");
+foreach $file (sort keys %Old) {
+  my $status = $New{$file} ? "retained" : "removed";
+  print "* $file\t[$status]\n";
+
+  # if the old file does not exist, don't try to remove it -- we
+  # probably did so by hand and didn't bother to update.
+  next unless -e "$M/$file";
+
+  # remove old files.
+  if (! $New{$file}) {
+    &xsystem ("svn remove $M/$file");
+  }
+
+  my $dname = dirname ("$M/$file");
+  $dirs{$dname}++;
+}
+
+# copy files
+my $job = "tar cf - . | (cd $M && tar xf - )";
+&xsystem ($job);
+
+# sort so dirs will be added before subdirs.
+foreach $file (sort keys %New) {
+  if (! $Old{$file}) { 
+    &add_file ("$M/$file");
+  }
+}
+
+&xchdir ($cooked);
+&xsystem ("mv $package $package.done");
+
+
+if ($newpackage) {
+  &add_file ("$M/tlpkg/tlpsrc/$package.tlpsrc");
+}
+
+# this file will often change, so be sure and include it.
+$dirs{"$M/tlpkg/tlpsrc/$package.tlpsrc"}++;
+
+# print dirs with changed files, for svn commit purposes.
+# if other files have been modified in those same dirs, though, this
+# won't detect it.  It would be better to list exactly the *files* which
+# should be committed, but ... lazy.
+# 
+# also write dir list to a separate file, for easy passing to a commit.
+# 
+my $dirlist_file = "$tmpfile.dirs";
+$DIRLIST = ">$dirlist_file";
+open (DIRLIST) || die "open($DIRLIST) failed: $!";
+#
+print "place: directories are:\n";
+for my $dir (sort keys %dirs) {
+  print "$dir\n";
+  print DIRLIST "$dir\n";
+}
+#
+close (DIRLIST) || warn "close($DIRLIST) failed: $!";
+
+# Always run svn update, even without --place.  This will let a user
+# detect that a particular package update has already been done by
+# someone else.
+print ("\nsvn update of those directories:\n");
+system ("svn update `cat $dirlist_file`");
+
+exit (0);
+
+
+
+#--------------------------------------
+sub dirs
+{
+    local @filenames;
+   if (-d) { 
+       @filenames=&buildfilelist($File::Find::name);
+    if (!@filenames) { rmdir $File::Find::name;}
+  }}
+
+sub buildfilelist
+{
+    my($me) = @_;
+    my @files;
+    opendir(DIR,$me) || cleanup ("cannot open directory $me");
+    @files =grep(!/^\.\.?/,readdir(DIR));
+    closedir(DIR);  
+    return @files;
+}
+
+
+sub files
+{
+  if (-f || -l) {  # consider files or symlinks
+    $This = $File::Find::name;
+    $This =~ s/^\.\///;
+    $New{$This} = 1;
+ }
+}
+
+
+# add a file to the repository.  for svn, we also have to add the
+# containing dir, and the parent of that dir, if they are new.
+# (Should really just traverse )
+# 
+sub add_file
+{
+  my ($newfile) = @_;
+  
+  # when it's needed, (grand)parents must come first, else have svn "not
+  # working copy".  
+  my $newdir = $dir = dirname ($newfile);
+  my $needed_dirs = "";
+  until (-d "$dir/.svn") {
+    $needed_dirs = "$dir $needed_dirs";  # parents first
+    $dirs{$dir}++;
+    $dir = dirname ($dir);
+  }
+  &xsystem ("svn add -N $needed_dirs") if $needed_dirs;
+
+  &xsystem ("svn add $newfile");
+
+  # remember that we changed this directory.
+  $dirs{$newdir}++;
+}
+
+
+sub xchdir
+{
+  my ($dir) = @_;
+  chomp (my $pwd = `pwd`);
+  chdir ($dir) || die "chdir($dir) failed: $!\n(cwd=$pwd)";
+  print "place: chdir($dir)\n";
+}
+
+
+sub xsystem
+{
+  my ($cmd) = @_;
+  
+  print "place: SYSTEM $cmd\n";
+
+  unless ($chicken) {
+    my $ret = system ($cmd);
+    $ret /= 256;
+    die "`$cmd' failed, status=$ret, goodbye\n" if $ret != 0;
+  }
+}