summaryrefslogtreecommitdiff
path: root/Master/tlpkg/libexec/place
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2009-01-01 01:55:30 +0000
committerKarl Berry <karl@freefriends.org>2009-01-01 01:55:30 +0000
commitbd36ab79b831cabded89ff0328c7c0e410872997 (patch)
treeb152de091ec0fe4e689110136143d6187d266c39 /Master/tlpkg/libexec/place
parenta477b52f73704eea5cc4af4652969b00329cbfa6 (diff)
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
Diffstat (limited to 'Master/tlpkg/libexec/place')
-rwxr-xr-xMaster/tlpkg/libexec/place301
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;
+ }
+}