path: root/Master/tlpkg/libexec/place

#!/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;
  }
}