#!/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 %Old; my $tlpold = $tlpdb->get_package ($package); if (defined($tlpold)) { foreach ($tlpold->all_files) { $Old{$_} = 1; } } else { $newpackage = 1; } # create new tlpsrc. 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: $!"; # not needed, we only set name and category which are taken # be default from the file name, so do not create useless entries # but only empty files # $tlpsrc->writeout(\*TLPSRC); close TLPSRC; } } else { $tlpsrc->from_file($tlpsrcfile); } # make the new tlpobj. my $tlpnew = $tlpsrc->make_tlpobj($tltree, $M); # show comparison of old and new. print "\n\f "; &compare_disk_vs_tlpobj ("$cooked/$package", $tlpnew); 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 = keys %Old; `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. for my $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 worker # 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; # sometimes the add fails due to svn guessing wrongly about a file # being binary vs. text, or mixed eol conventions. Attempt to repair # -- just with pdf for now. This is not tested and needs work. # if (!defined (eval qq(xsystem("svn add $newfile"))) && $newfile =~ /\.pdf\$/) { &xsystem ("svn proplist --verbose $newfile"); &xsystem ("svn propset svn:mime-type application/pdf $newfile"); } # remember that we changed this directory. $dirs{$newdir}++; } # compare against independent list of files in the new hierarchy, in # case some of them did not get matched by the patterns. sub compare_disk_vs_tlpobj { my ($diskdir,$tlp) = @_; chomp (my @files_on_disk = `cd $diskdir && find \! -type d`); s,^\./,, foreach @files_on_disk; # remove leading ./ @files_on_disk{@files_on_disk} = (); # make list into hash for my $tlpfile ($tlp->all_files) { if (exists $files_on_disk{$tlpfile}) { delete $files_on_disk{$tlpfile}; } else { print "$tlpfile in tlp but not on disk?!\n"; } } print "\n*** not matched in new tlp: ", join ("\n ", keys %files_on_disk), "\n" if keys %files_on_disk; } 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; } }